home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1993 / Internet Info CD-ROM (Walnut Creek) (1993).iso / networking / terms / kermit / d / gecker.sou < prev    next >
Encoding:
Text File  |  1989-06-07  |  114.3 KB  |  2,917 lines
  1. // KERMIT V 3.9 MAY 89  G.J.S.
  2.  
  3. // Kermit is a product of Columbia University Centre for Computing Activities.
  4.  
  5. // This version and v. 3.6 developed by G. Sands ,Marconi Space Systems for
  6. //  standard OS4000. 
  7. // V. 3.8 by J. Campbell, Physics dept, Univ. of Birmingham (standard OS).
  8. // All other versions by M. J. Loach , RAL , for RAL OS4000.
  9. // This version runs on standard GEC with no patching.
  10. // NOTE: only verified on TF terminals with PCC
  11. //
  12. // Intended for use with the GEC version of OS4000, note that changes
  13. // may be required for use on RAL OS4000, viz , the  /!RAL/!  and /!GEC/!
  14. // flagged lines. This version will be ready to compile for GEC version.
  15. // In order to compile for standard RAL system, comment out /!GEC/! lines
  16. // and reinstate /!RAL lines.
  17. //
  18. //
  19. //
  20.  
  21. //    "Permission is granted to any individual or institution to copy or use
  22. //     this program, except for explicitly commercial purposes."
  23.  
  24. // Routines added since 2.1
  25. // SERVER_CONTROL
  26. // DEBRIEF
  27. // FILE_PARSER
  28. // EN_PREFIX
  29. // DE_PREFIX
  30. // FILE_DE_PREFIX
  31. // IOERR
  32.  
  33. // Work done since 2.1
  34. // 1. NX() was still used into Kermlog, has been changed
  35. // 2. Message from Sfile faulty
  36. // 3. Code in Sfile re-written
  37. // 4. Server provided, with help etc, Rinit and Parser modified to suit
  38. // 5. I/O buffers enlarged, prevents overwriting of log
  39. // 6. Packet size increased to 94 for send, and 80 for receive.
  40. // 7. DM Error codes written to logfile after dmconnect. (PRRA)
  41. // 8. ENPREFIX added, extracted from BUFILL
  42. // 9. DEPREFIX added, extracted from BUFEMP
  43. //10. LEN in SFILE replaced by LF (bug) in error messages.
  44. //11. DEPREFIX added to Server_control for R filename packets.
  45. //11A.Prefixing 8 bit quoting now handled if been agreed, not only if Binfile.
  46. //12. Repeat count prefixing added.
  47. //13. Rtypecheck added to allow GEC version of Rfile to compile.
  48. //14. Sfile now does filename conversion to normalform on option .
  49. //15. Hashfile(Rfile) now does filename conversion to normalform on option.
  50. //16. Shower now displays Off/On instead of 1/0.
  51. //17. Extra debug message, 'oname receiving as newname'
  52. //18. file_de_prefix added to de prefix rec f paks and server R pak.
  53. //19. en_prefixing put into Sfile, mainly for & i suppose...
  54. //20. Bufemp modified to restrict the length of text file records to 235.
  55. //21. RECEIVE modified to allow one parameter to specify a receive filename.
  56. //22. If WITH stream specified in process call then take commands from file.
  57. //
  58. // Mods for 3.1
  59. //
  60. // 1. Generic logout included to stop Kermit but no logout, + error message.
  61. // 2. Other Generic commands generate error condition.
  62. // 3. I packets get error message only if quoting not agreed in Binary mode.
  63. //
  64. // Mods for 3.2
  65. //
  66. // 1. /!GEC/! version failed if timeout, fixed.
  67. //
  68. // Mods for 3.3
  69. //
  70. // 1. RPAR changed to handle 'Y' in incoming init QBIN parameter correctly.
  71. // 2. DE_PREFIX comment altered and EN_PREFIX changed to do 11A above correctly
  72. //
  73. // Mods for 3.4
  74. //
  75. // 1. LAST_RETRY added to RPACK to allow checking for a change of reason for
  76. //    retry, in which case the NUMTRY count must be reset. Formerly, five
  77. //    timeouts followed by six checksum errors would have exceeded the limit.
  78. // 2. SET SIZE added to allow changing RPSIZ for protocol variants.
  79. //
  80. // Mods for 3.5
  81. //
  82. // 1. MAXL is redefined by F DE CRUZ as max Len instead of max packet size.
  83. //    Therefore SPSIZ and RPSIZ go down by 2. Alter RPAR and Buffil. Removed
  84. //    the extra character margin from the check, SPSIZ-8 +2 +1 is SPSIZ-5.
  85. //    But also there is a bug in that loop can continue to 5 more chars, not
  86. //    3, so we get SPSIZ-7.
  87. //
  88. // Mods for 3.6
  89. //    Version 3.6 was produced by G Sands, Marconi for Physical mode.
  90. //
  91. // 1. File transfer is done with the terminal in physical mode. This takes
  92. //    care of ?s,linelength restrictions and echo suppression. Also there is a
  93. //    very handy "PUT followed by a timed-out GET" construction. This is used
  94. //    whenever a response is expected to a packet being sent. It is also used,
  95. //    with an empty PUT, when awaiting an initial packet from the other end.
  96. //    This construction has the advantage that the GET is cancelled if it is
  97. //    timed out.
  98. // 2. "Reset terminal to default" instruction is followed by "set backspace=?C".
  99. // 3. /Z... has been added to &KERMLOG, to avoid long transfers crashing when
  100. //    debug is on.
  101. // 4. RPSIZ and limit on SPSIZ in RPAR increased to 94.
  102. // 5. Since the PUT-GET time limit is in seconds not millis and is specified in
  103. //    RX, TIMEOUTs are in seconds and are HALFs (DELAY remains in millis.).
  104. //    Timeout is set only when entering physical mode or when changed, not at
  105. //    each GET.
  106. // 6. HELP SET refers to &KERMLOG not .KERMLOG.
  107. // 7. If receiving and get packet N-1, ack N-1 not N.
  108. // 8. "Now type local ..." added to RECEIVE and SEND.
  109. // 9. Data management errors on send or recieve files are reported - not fatal.
  110. //
  111. //    Routines altered:
  112. //      NEXTC           new buffer is got with a PUT-GET with an empty PUT,
  113. //                      Tests SPACK_TIMEOUT before anything else.
  114. //      RPACK           reset changed for physical after ^Z. 3 ll after =>NUM,
  115. //                      (0) added after RETURN.
  116. //      SPACK           if LISTEN=1, does a PUT-GET. If data recieved, sets
  117. //                      POINTER for NEXTC to return 1st chara in buffer. Resets
  118. //                      LISTEN to 1 on exit. If timeout, flags to NEXTC.
  119. //      RPAR            limit on SPSIZ is 94. TIMEOUT in secs.
  120. //      ERROR           0=>LISTEN before SPACK
  121. //      RTYPECHECK      OPEN options changed.
  122. //      RFILE           0=>LISTEN before ack-ing 'B' packet. If get packet
  123. //                      N-1 ack that not N.
  124. //      RDATA           ack N-1 not N. Trap 'A' from BUFEMP. Trap DMAN error on
  125. //                      PUT.
  126. //      DE_PREFIX       Bug fix as mentioned in 00MAIL90.
  127. //      BUFEMP          Trap DMAN error on PUT.
  128. //      SFILE           OPEN options changed. Trap 'A' from BUFILL.
  129. //      GETC            Trap DMAN error and return -2 on GET.
  130. //      BUFILL          Trap -2 from GETC, pass on.
  131. //      SDATA           Trap 'A' from BUFILL.
  132. //      DEBRIEF         PUT to INSTREAM not OUTSTREAM, follow with CRLF (both
  133. //                      due to physical mode). WAIT removed.
  134. //      SERVER_CONTROL  initialisation changed for physical mode. Return to
  135. //                      logical before resetting terminal. 0=>LISTEN before
  136. //                      ack-ing 'F'. Set timeout when changed.
  137. //      PARSER          TIMEOUT in secs.
  138. //      MAIN            transfer initialisation changed for physical mode and
  139. //                      timeout set. Return to logical before resetting
  140. //                      terminal. IF REMOTE and RFLG or SFLAG output
  141. //                      "Now type local ... ".
  142. //
  143. //
  144. // Mods for 3.7
  145. //
  146. // 1. DE_PREFIX last line, save of ra to databuf included to correct
  147. //    bug causing only first decoded repeated char to be correct.
  148. // 2. EN_PREFIX test in first line changed to test for state S, this
  149. //    caused repeating to not be done on first packet from file.
  150. // 3. EN_PREFIX and GETC heavily hacked to get repeat count prefixing
  151. //    to work properly on Binary file transfers, particularly when
  152. //    2-3 reps were found at the end of a record.
  153. // 4. RDATA AND RFILE altered so that acks for previous packets received
  154. //    again are correctly numbered with the previous packet number. This
  155. //    fix includes correcting the packet length of the first ack in RDATA
  156. //    to zero.
  157. // 5. Length of INBUF extended so that GETC can read records up to
  158. //    1024 in length.
  159. // 6. Attributes Z(1,1,127) added to Kermlog open to provide larger
  160. //    extension.
  161. // 7. Missing RETURN with RA set to zero corrected in RPACK
  162. //    (after 'TYPE' decoded)
  163. // 8. Comments relating to NUM and N corrected.
  164. //
  165. // Mods for 3.8
  166. // 1. Version 3.6 for tf/tc merged with version 3.7
  167. // 2. Generic command 'T' added for remote typing of file.
  168. //
  169. // Mods for 3.9
  170. //
  171. // 1. Test for EOF added in EN_PREFIX (otherwise if last chara. of file is a
  172. //    null get infinite loop).
  173. // 2. In GETC, extra trap on BINEOF. Otherwise infinite loop if file ends with
  174. //    same chara. repeated 2 or 3 times.
  175. // 3. Trap ctrlZ throughout RPACK. Trap premature CR & packet not being followed
  176. //    by CR - treat as checksum error.
  177. // 4. ROUTINE CLOSEDOWN added, principally to avoid displacement errors.
  178. // 5. Version 3.6 mods reintroduced in PRRA, DEBRIEF, RDATA, BUFEMP and
  179. //    SERVER_CONTROL.
  180. // 6. Minor bug fixes to GETC, SEOF, BUFEMP and BUFILL.
  181. // 7. Repeat CONTROLs if timeout. If parity not stripped, mask whole buffer in
  182. //    one go.
  183. // 8. If nothing to do, exit before going physical.
  184. // 9. Prevent normalised name starting with a digit.
  185. // 10. If RECEIVE <filename>, ensure group doesn't go to same file.
  186. //
  187. // ****************************************************************************
  188.  
  189. DATA CHAPTER MDAT
  190.  
  191. LITERAL
  192.  
  193. INSTREAM=1,                                  // stream for control input
  194. OUTSTREAM=2,                           // stream for output to control(terminal)
  195. TEXTIN=0,                                    // open option for text input
  196. TEXTOUT=1,                                   // open option for text output
  197. BININ=2,                                     // open option for binary input
  198. BINOUT=3,                                    // open option for binary output
  199. CR=13,                                       // carriage return constant
  200. LOGSTREAM=10,                                // log file for debug info etc
  201. FILESTREAM=12,                              // stream for writing files received
  202. READSTREAM=11,                               // stream for reading files to send
  203. WITHSTREAM=5                       // stream for reading commands from TAKE file
  204.  
  205. // ****************************************************************************
  206.  
  207. VECTOR [0,237] OF BYTE TITLE=("~",
  208. "KERMIT file transfer utility, Version 40/3.9 for GEC 4000 by G Sands,Marconi~",
  209. " Kermit-Copyright Columbia University Centre for Computing Activities, 1988 ~",
  210. "~Help knows about_ SEND,RECEIVE,SET,SHOW,STATUS,SERVER,HELP,END,BYE,EXIT",
  211. " and QUIT~$")
  212. VECTOR [0,10] OF BYTE PROMPT="Kermit-40> "   // belongs to parser
  213.  
  214. // buffers
  215.  
  216. VECTOR [0,120] OF BYTE BUF    // input buffer from remote and also command input
  217. VECTOR [0,2] OF BYTE PREBUF        // fiddle space for adding things in enprefix
  218. VECTOR [0,1023] OF BYTE INBUF          // input buffer from files (routine getc)
  219. VECTOR [0,1] OF BYTE CHAR
  220. VECTOR [0,120] OF BYTE DATABUF               // buffer for data in packets
  221. VECTOR [0,249] OF BYTE BUFFER  // buffer for data going to file (routine bufemp)
  222. VECTOR [0,24] OF BYTE MESS ="There is a checksum error"
  223.  
  224. // debug vectors
  225.  
  226. VECTOR [0,120] OF BYTE DBUF                  // used by dprint
  227. VECTOR [0,6] OF BYTE DMESS1 ="RPACK: "
  228. VECTOR [0,21] OF BYTE DMESS2="LEN= NUM= TYPE= DATA= "
  229. VECTOR [0,6] OF BYTE DMESS3="SPACK: "
  230. VECTOR [0,14] OF BYTE DMESS4="RECSW: STATE=  "
  231. VECTOR [0,33] OF BYTE DMESS5="File being opened for sending is: "
  232. VECTOR [0,18] OF BYTE DMESS6="Closing input file "
  233. VECTOR [0,26] OF BYTE DMESS7="looking for next file......"
  234. VECTOR [0,12] OF BYTE DMESS8="New file is- "
  235. VECTOR [0,15] OF BYTE DMESS10="SENDSW: STATE=  "
  236. VECTOR [0,11] OF BYTE DMESS11="Send command"
  237. VECTOR [0,14] OF BYTE DMESS12="Receive command"
  238. VECTOR [0,13] OF BYTE DMESS13="Receive failed"
  239. VECTOR [0,4] OF BYTE DMESS14="done."
  240. VECTOR [0,10] OF BYTE DMESS15="Send failed"
  241. VECTOR [0,44] OF BYTE DMESS16="File already exists with different attributes"
  242. VECTOR [0,57] OF BYTE ERRVEC=("Kermit aborting with the following error from ",
  243. "remote host:")
  244. VECTOR [0,14] OF BYTE CREFAIL="Cannot create: "
  245. VECTOR [0,26] OF BYTE CRETEXT="Cannot open file:(binary?):"
  246. VECTOR [0,28] OF BYTE CREBIN="Cannot open file:(textfile?):"
  247. VECTOR [0,26] OF BYTE CRETYPE="Cannot open file:(not LS?):"
  248. VECTOR [0,21] OF BYTE DMANERR="Data management error "
  249. VECTOR [0,10] OF BYTE SENDMESS="Sending as "
  250. VECTOR [0,13] OF BYTE RXMESS=" Receiving as "
  251. VECTOR [0,37] OF BYTE MESSTIME="Timeout retries exceeded, press return"
  252. VECTOR [0,33] OF BYTE MESSTRY="Too many retries, transfer aborted"
  253. VECTOR [0,52] OF BYTE MESSYBIT=("8 bit quoting not agreed,",
  254. " so can't do binary transfer")
  255. VECTOR [0,27] OF BYTE NOTSERV="Unimplemented server command"
  256. VECTOR [0,46] OF BYTE BYEMESS="Generic Logout not possible, but Kermit stopped"
  257. VECTOR [0,57] OF BYTE SIGNON=("Kermit-40: Server Running, Now type local ",
  258.     "escape sequence-")
  259. VECTOR [0,31] OF BYTE TAKING="Taking commands from With stream"
  260. VECTOR [0,18] OF BYTE TAKEN="End of command file"
  261. VECTOR [0,13] OF BYTE ABSTOP="Kermit aborted"
  262. VECTOR [0,10] OF BYTE STAMP="Kermit-40: "
  263. VECTOR [0,3] OF BYTE SINK="SINK"
  264. VECTOR [0,1] OF BYTE CRLF=HEX"0D0A"          // Not automatic in PHYS
  265.  
  266. // filelist vectors
  267.  
  268. VECTOR [0,96] OF BYTE FILELIST               // filelist from command line
  269. VECTOR [0,49] OF BYTE FILNAM1
  270. VECTOR [0,49] OF BYTE FILNAM=("%C                                     ",
  271.   "           ")
  272. VECTOR [0,49] OF BYTE NEWFILNAM
  273. VECTOR [0,22] OF BYTE LOGVEC="&KERMLOG/Z(1,1,127)/ADD"
  274. /!GEC/!VECTOR [0,14] OF BYTE ATTRIBUTE='/NEW/Z(1,1,127)'
  275. VECTOR [0,3] OF BYTE LSB="/LSB"
  276.  
  277. // command parser
  278.  
  279. VECTOR [0,14] OF BYTE COMMESS="Invalid command"
  280. VECTOR [0,47] OF BYTE COMMANDS=("ENDEXITSENDRECEIVESETHELPSHOWSTATUSQUITBYE",
  281.   "SERVER")
  282. VECTOR [0,16] OF BYTE TOOMESS="Excess parameters"
  283. VECTOR [0,20] OF HALF MARKS    // holds pointers to command and parameter posits
  284. VECTOR [0,16] OF BYTE INVPARM="Invalid parameter"
  285. VECTOR [0,13] OF BYTE NOHELP="No information"
  286. VECTOR [0,21] OF BYTE RANGEMESS="Parameter out of range"
  287. VECTOR [0,80] OF BYTE PARAMS=("EOLDEBUGTIMEREMOTEIMAGESTXPADCHARSENDRETRYS",
  288. "QUOTETIMEOUT8BITBINARYREPEATNORMALSIZE")
  289. VECTOR [0,4] OF BYTE OFF="OFFON"
  290. // ****************************************************************************
  291.  
  292. VECTOR [0,475] OF BYTE SHOWVEC=(
  293. " Status of SET parameters-                                                  ",
  294. " Debug      is set to    ",
  295. " Remote     is set to    ",
  296. " Image      is set to    ",
  297. " Eol        is set to    ",
  298. " Stx        is set to    ",
  299. " Pad        is set to    ",
  300. " Char       is set to    ",
  301. " Send       is set to    ",
  302. " Retrys     is set to    ",
  303. " Time       is set to    ",
  304. " Timeout    is set to    ",
  305. " Quote      is set to    ",
  306. " 8bit       is set to    ",
  307. " Binary     is set to    ",
  308. " Repeat     is set to    ",
  309. " Normal     is set to    ")
  310.  
  311. // ****************************************************************************
  312.  
  313. VECTOR [0,1] OF BYTE HELP
  314. VECTOR [0,769] OF BYTE HELP1=("~",
  315. "                            SEND COMMAND ~",
  316. "                            ************ ~~",
  317. "  (S)END switches Kermit into send mode. There are no mandatory parameters.~",
  318. "  If no parameters given then the current file is used (%C). Otherwise the ~",
  319. "  parameters are standard GEC filenames. There is no wildcard. Unless      ~",
  320. "  otherwise switched off with Set Normal Off (see Help Set), filenames are ~",
  321. "  hashed into 'Normal-form' by removal of directory structures. Following  ~",
  322. "  this command  Kermit-40  starts  sending the first packets,  and local   ~",
  323. "  Kermit should be switched to receive mode straight away. There is a 15   ~",
  324. "  second (default) delay period allowed. Files are transfered until all    ~",
  325. "  files are sent, or until abort condition occurs.                        ~$")
  326.  
  327. VECTOR [0,988] OF BYTE HELP2=("~",
  328. "                            RECEIVE COMMAND                                ~",
  329. "                            ***************                               ~~",
  330. "   (R)ECEIVE switches Kermit into receive mode. One parameter is allowed.  ~",
  331. "   If a GEC filename is given as the first parameter then this filename    ~",
  332. "   will be used for the file received from the local Kermit, and if not    ~",
  333. "   the name(s) of file(s) to be created are received from the local        ~",
  334. "   Kermit and, provided Set Normal Off has not been used (see Help Set),   ~",
  335. "   the names are reformatted if necessary to valid GEC names. Any existing ~",
  336. "   files of the same name will be appended.   Following this command       ~",
  337. "   Kermit-40  goes into  wait state,  until a valid acceptable packet is   ~",
  338. "   received from the local Kermit, whereupon file transfer will continue   ~",
  339. "   until close and break received or abort condition occurs. This Kermit   ~",
  340. "   will then re-enter command mode.                                       ~$")
  341. VECTOR [0,1368] OF BYTE HELP3=("~",
  342. "                            SET COMMAND                                    ~",
  343. "                            ***********                                   ~~",
  344. "   (SET) allows certain parameters to be switched on and off, or set to a  ~",
  345. "   value. The ones available at present are-    (s-on/off, n-value)        ~",
  346. "   DEBUG s- If on, debugging information is logged to &KERMLOG, default off~",
  347. //  REMOTE s-If on, this Kermit will work as a remote device, default on    ~",
  348. //  IMAGE s- If on, image mode, (8 bit transfers, not available on OS4000)  ~",
  349. "   EOL n-   set END-OF-LINE character, to ascii value n, default 13(CR)    ~",
  350. "   STX n-   set start of packet text sync char to ascii n, default 1       ~",
  351. "   PAD n-   set number of pad characters to preceed each packet, default 0 ~",
  352. "   CHAR n-  set pad character to be ascii n, default 0 (null)              ~",
  353. "   SEND n-  set delay before first SEND packet to n secs, default 15       ~",
  354. "   RETRYS n-set maximum number of sending retries before abort,default 10  ~",
  355. "   TIME n-  set number of seconds before micro-kermit times me out, def 5  ~",
  356. "   TIMEOUT n- set number of seconds for Kermit-40 timeout, default 10      ~",
  357. "   QUOTE n- set the ASCII value of the character I send for quoting,def 35 ~",
  358. "   8BIT n-  set ASCII value of the character I send for 8bit quoting. (38) ~",
  359. "   BINARY s-If on, LSB files are sent and received, via 8bit quote. (off)  ~",
  360. "   REPEAT n-set ASCII value of the character I send for repeat quote.(126) ~",
  361. "   NORMAL s-If on, filenames are converted to a 'normal form', default on ~$")
  362. VECTOR [0,304] OF BYTE HELP4=("~",
  363. "                           SHOW/STATUS COMMAND                             ~",
  364. "                           *******************                            ~~",
  365. "   (SH)OW displays the current state of SET parameters and various other   ~",
  366. "   useful information concerning this Kermit.                             ~$")
  367. VECTOR [0,228] OF BYTE HELP5=("~",
  368. "                           HELP COMMAND                                    ~",
  369. "                           ************                                   ~~",
  370. "   (H)ELP is this command, so you know how to use it!                     ~$")
  371. VECTOR [0,228] OF BYTE HELP6=("~",
  372. "                           QUIT/EXIT/END/BYE                               ~",
  373. "                           *****************                              ~~",
  374. "   (Q)UIT, (E)XIT, (E)ND and (B)YE are synonomous commands to stop Kermit ~$")
  375. VECTOR [0,608] OF BYTE HELP7=("~",
  376. "                           SERVER COMMAND                                  ~",
  377. "                           **************                                 ~~",
  378. "   (SER)VER will invoke the Kermit Server mode. In server mode, Kermit-40  ~",
  379. "waits for command packets to be received from the local Kermit. The user   ~",
  380. "should escape back to the local Kermit and use GET and SEND commands to    ~",
  381. "receive and send files respectively. The local kermit must be capable of   ~",
  382. "operation with a remote server. The command FINISH on the local server will~",
  383. "switch Kermit-40 back to command mode.                                    ~$")
  384.  
  385. VECTOR [32,126] OF BYTE TABLE=
  386. (" !",34,"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ",
  387. "[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~")
  388.  
  389. // ****************************************************************************
  390.  
  391. BYTE
  392.  
  393. DEBUG=0,                                     // if 1 then debug mode
  394. N=0,                                         // number of outgoing packet
  395. NEXTN,                                       // save-space for N
  396. NUMTRY=0,                           // number of times tried to send without ack
  397. MAXTRY=10,                               // max number of times to try resending
  398. OLDTRY=0,                                    // previous value
  399. STATE,                                  // holds current state of state switcher
  400. F_OR_X_FLAG,                                 // file or text transfer
  401. REMOTE=1,             // set 1 means remote mode , always for this remote kermit
  402. IMAGE=0,                     // set 0 means no image mode, always on this kermit
  403. BINFILE=0,                          // file type being transfered, 1=bin, 0=text
  404. FP=0                                       // indicates if file open for sending
  405.  
  406. EXTERNAL ROUTINE
  407.  
  408. //data management
  409. OPEN,CLOSE,                                  // files
  410. GET,GETO,PUT,                         // get lines and put lines to/from streams
  411. TOCHAR,                                      // convert ra to string
  412. FROMCHAR,                                    // convert string to number in ra
  413. CONTROL,                                  // alter defaults affecting LT process
  414. DMCONNECT,                                   // connects file name to stream
  415. DECODEIO,        // used to decode a geto after a message which is not a timeout
  416. GETSTREAMARG             // used to find out if a With stream has been specified
  417.  
  418. HALF
  419.  
  420. MILLI=1000,                                  // one thousand
  421. INBUFLEN=1024,                               // length of INBUF for GETC
  422. REREAD,                    // flag to show GETC not to read new record when GP<0
  423. RECLEN,                                      // record length for getc
  424. DBUFP=0,                               // hold the pointer for addvec addnum etc
  425. FLAG8=0,                            // flag to indicate an eight bit quote found
  426. TIMING=0,                         // flag to indicate ipm awaited during timeout
  427. TIMIDMODE=HEX'8101',                // timeout message id and mode are @81 and 1
  428. TIMIDCAN=HEX'8100',                          // timeout message id for cancel
  429. NPACK,                                       // packet number printed in dpack
  430. STX=1,                                       // control-a start of packets
  431. IB=0,                                        // counter in bufemp
  432. NEWARNCH=HEX'02F5',                          // set warning character in control
  433. /!RAL//TERMWIDTH=HEX'02E0',     // set terminal width in control
  434. /!RAL//HDX=HEX'0011',    // set lt to half duplex
  435. /!RAL//CONLT=HEX'02E3',  // RAL control command
  436. /!GEC/!CONLT=HEX'02FE',  // for asis control
  437. DEFAULT=HEX'02FF',                           // reset terminal to default
  438. ALTCHAR=HEX'02F7',                           // control code for ?X
  439. OFS=0,                                       // offset for writing help messages
  440. /!RAL//ATTRIBUTE=LOGVEC+19,      // '/add' for filename
  441. READFAIL=CRETEXT,                            // part message for dmconnect
  442. EOFPENDING=0,                      // shows eof found on end of buffer in bufill
  443. NOCRLF=HEX'02F0',                            // mask for data management control
  444. /!GEC/!NOECHO=HEX'02F2', // to prevent packets being echoed
  445. EVEN=HEX'0FF0',                              // gets PHYS to expect even parity
  446. STOP_ON_CR=HEX'0FF2',                       //  "    "   "  terminate GETs on CR
  447. PGTCODE=HEX'0FF9',                           //  PUT-GET time limit control code
  448. PUTGET=HEX'0FF8',                            //   "   "  control code
  449. TXIN_ERR=HEX'8000',         // open option for text input with non-default error
  450.                                              // options
  451. TXOUT_ERR=HEX'8001',                         // ditto for text output
  452. BININ_ERR=HEX'8002',                         // ditto for binary input
  453. BINOUT_ERR=HEX'8003',                        // ditto for binary output
  454. ERROPT=HEX'FFFF',             // return all DMAN errors to program, don't report
  455.                                              // to terminal line
  456. // ERROPT_LOCAL=HEX'5555',  - return to screen as well.
  457. LISTEN=1,                      // used to decide between PUT-GET and normal PUT.
  458. LEN,                                         // length of packet data
  459. NUM,                                       // packet number for received packets
  460. TYPE,                                        // packet type
  461. POINTER=-1,                                  // used in routine nextc
  462. PP,                                          // used as parser pointer
  463. MASK=HEX'007F',                             // mask to strip parity bit in nextc
  464. ERMASK=HEX'F000',                            // used after fromchar
  465. CCHKSUM,                                     // calculated checksum
  466. RCHKSUM,                                     // received checksum value
  467. I,J,                                   // scratch temporarys for loop counts etc
  468. MASK1=HEX'00C0',MASK2=HEX'003F',             // used in checksum calculation
  469. POINT,                                       // used by routine dpack
  470. INDEX,                                       // counter in spack
  471. SAVE,                                        // save location
  472. HEXPRINT=256,                                // tochar mode
  473. LF=2,                                        // length of filename  (%c)
  474. P,                                           // pointer for gnxtfl
  475. IP=0,                                        // parm counter for gnxtfl
  476. SIZE,                                 // length of data in buffer from send file
  477. GP=-1,                                       // routine getc pointer
  478. EOFLAG=0,                                    // set to 1 on eof
  479. BINEOF=0,                   // Set to 1 on binary eof if finished on 2 or 3 reps
  480. CFLG=0,SFLG=0,RFLG=0,         // flags to show mode, one of connect,send,receive
  481. NPARMS,                            // number of parameters found on command line
  482. COMSIZ=47,                                   // length of possible commands list
  483. LCMASK=HEX'00DF',                          // mask to force alphas to upper case
  484. PARMSIZ=77,                           // length of possible parameters list(set)
  485. SERVER=0,                                  // If 1 indicates server mode entered
  486. RCOUNT=1,                                    // Count for repeat prefixing
  487. NORMAL=1,             // If NOT set normal form conversion of filenames not done
  488. TAKE_FILE=0,           // If set then Parser will take commands from With stream
  489. LAST_RETRY=0,  // Indicates reason for last retry. 1 for timeout, 2 for checksum
  490.  
  491. // defaults i assume until init received
  492.  
  493. SPSIZ=65,                                    // max send packet size
  494. PAD=0,                                       // how much padding to send
  495. EOL=13,                                      // eol character to send
  496. PADCAR=0,                                    // pad character to send
  497. QUOTE=35,                                // quote character in incoming data (#)
  498. TIMINT=10,                                   // when to time out other Kermit
  499. EIGHTQ=78,                              // eight bit quote in incoming data('n')
  500. CHKTYPE=' 1',                                // checksum type
  501. RPEAT=32,                           // repeat count prefix assumed(sp- not done)
  502.  
  503. // what i want which i ask for in init
  504.  
  505. RPSIZ=94,                                    // largest LEN i can receive
  506. MYTIME=5,                                    // when i want to be timed out
  507. MYPAD=0,                                     // number of pad chars i want
  508. MYPCAR=0,                                    // pad char i want
  509. MYEOL=13,                                    // end of line char i want
  510. MYQUOTE=35,                                  // control quote char i send  (#)
  511. MY8BIT=38,                                   // 8 bit quote i send (&)
  512. MYCHECK=' 1',                                // checksum i do
  513. MYRPEAT=126                                  // repeat prefix char i send
  514.  
  515. FULL DMERRMASK=HEX'80000000',EOFMASK=HEX'FFFF0000',EOF=HEX'80000000'
  516.  
  517. END
  518.  
  519. //******************************************************************************
  520.  
  521. PROGRAM CHAPTER KERMIT
  522.  
  523. GLOBAL DATA  CHAPTER MDAT
  524.  
  525. ENTRY LABEL ENTRYPOINT
  526.  
  527. // 'vector table' for parser and help
  528.  
  529. VECTOR [0,47] OF FREE LABEL WHATCOM=(EX,E,E,EX,E,E,E,SE,E,E,E,RE,E,E,E,E,E,E,ST,
  530. E,E,HP,E,E,E,SH,E,E,E,SH,E,E,E,E,E,EX,E,E,E,EX,E,E,SV,E,E,E,E,E)
  531. VECTOR [0,47] OF FREE LABEL HELPARMS=(HQU,EH,EH,HQU,EH,EH,EH,HSE,EH,EH,EH,
  532. HRE,EH,EH,EH,EH,EH,EH,HST,EH,EH,HHP,EH,EH,EH,HSH,EH,EH,EH,HSH,EH,EH,EH,EH,EH,
  533. HQU,EH,EH,EH,HQU,EH,EH,HSV,EH,EH,EH,EH,EH)
  534.  
  535.  
  536. FREE ROUTINE                      // all these are to avoid displacement errors.
  537.  
  538. NX=FAR_NX,
  539. SPACK=FAR_SPACK,
  540. RPAR=FAR_RPAR,
  541. RPACK=FAR_RPACK,
  542. PRERRPKT=FAR_PRERRPKT,
  543. DPRINT=FAR_DPRINT,
  544. SINIT=FAR_SINIT,
  545. RECSW=FAR_RECSW,
  546. BUFILL=FAR_BUFILL,
  547. SDATA=FAR_SDATA,
  548. SEOF=FAR_SEOF,
  549. NEXTC=FAR_NEXTC,
  550. DPACK=FAR_DPACK,
  551. SPAR=FAR_SPAR,
  552. RINIT=FAR_RINIT,
  553. RFILE=FAR_RFILE,
  554. ERROR=FAR_ERROR,
  555. SFILE=FAR_SFILE,
  556. SENDSW=FAR_SENDSW,
  557. HELPER=FAR_HELPER,
  558. PARSER=FAR_PARSER,
  559. SHOWER=FAR_SHOWER,
  560. SERVER_CONTROL=FAR_SERVER_CONTROL,
  561. GNXTFL=FAR_GNXTFL,
  562. ADDVEC=FAR_ADDVEC,
  563. PUTVEC=FAR_PUTVEC,
  564. ADDNUM=FAR_ADDNUM,
  565. FILE_PARSER=FAR_FILE_PARSER,
  566. DEBRIEF=FAR_DEBRIEF,
  567. DE_PREFIX=FAR_DE_PREFIX,
  568. PRRA=FAR_PRRA,
  569. FILE_DE_PREFIX=FAR_FILE_DE_PREFIX,
  570. IOERR=FAR_IOERR,
  571. CLOSEDOWN=FAR_CLOSEDOWN
  572.  
  573. FREE LABEL FAR_MISS=MISS,FAR_ABORT=ABORT
  574.  
  575. EXTERNAL ROUTE  TIMEVENT, IOROUTE            // for timeout
  576.  
  577. HALF
  578. TIMEOUT=10,                                  // timeout after 10 seconds
  579. SERVER_TIMEOUT=30,                           // timeout during server idle time
  580. SAVE_TIMEOUT,                                // used by server to save value
  581. SPACK_TIMEOUT=0                              // flags SPACK timeout to NEXTC
  582.  
  583. FULL
  584. DELAY=15000,                                 // delay on first send packet
  585. SAVE_DELAY,                                  // used by server to save value
  586. SAVERA,                                      // save area for timeout event
  587. FTYPELS=HEX'000F0000',             // filetype logical sequential, for dmconnect
  588. FTYPETB=HEX'00200000'                  // filetype text or binary, for dmconnect
  589.  
  590. //******************************************************************************
  591.  
  592.      ROUTINE FAR_NEXTC()       // gets next char from remote, getting new record
  593.  
  594.      IF SPACK_TIMEOUT NE //0// THEN
  595.      <<
  596.           // SPACK puts message in logfile
  597.           0 => SPACK_TIMEOUT
  598.           1=>TIMING
  599.           // Controls already reset by SPACK.
  600.           RETURN(TIMIDMODE)                  // return with timeout indicated
  601.      >>
  602.  
  603.      IF POINTER LT  THEN                     // if needed.
  604.      <<
  605.  
  606.           // Use PUT-GET with an empty PUT.
  607.           CONTROL(INSTREAM,100,PUTGET)       // 100 is GET length
  608.           PUT(INSTREAM,0,BUF)                // and trigger timed
  609.           // GET(INSTREAM,100,BUF)
  610.           TEST RA LT //0// THEN
  611.           <<
  612.                PUT(LOGSTREAM,7,MESSTIME)     // record timeout in log file
  613.                1=>TIMING                     //
  614.                // May have lost controls - re-instate
  615.                CONTROL(INSTREAM,1,STOP_ON_CR)   // terminate gets on cr
  616.                CONTROL(INSTREAM,1,EVEN)      // check and strip even parity
  617.                CONTROL(INSTREAM,TIMEOUT,PGTCODE)   // timeout for put-gets
  618.                RETURN(TIMIDMODE)             // return with timeout indicated
  619.           >>
  620.           ELSE
  621.           <<
  622.                IF DEBUG NE THEN   PUT(LOGSTREAM,RX,//BUF//)
  623.                                              // write line to logfile
  624.                0=>POINTER
  625.                =>TIMING
  626.                CR=>BUF[RX]                 // [RX-1] should be CR,but make sure.
  627.           >>
  628.      >>
  629.      BUF[POINTER]
  630.      IF(,IMAGE EQ) THEN
  631.      IF //BUF[POINTER]// GE HEX'80' THEN
  632.      // MUST HAVE LOST CONTROLS - RE-INSTATE
  633.      <<
  634.           CONTROL(INSTREAM,1,STOP_ON_CR)     // terminate GETs on c. return
  635.           CONTROL(INSTREAM,1,EVEN)           // check and strip even parity.
  636.           CONTROL(INSTREAM,TIMEOUT,PGTCODE)  // timeout for put-gets
  637.           (,POINTER => RX)
  638.           REPEAT                             // mask rest of line.
  639.           <<
  640.                BUF[RX] & MASK =>BUF[RX]      // l.s. 7 bits only
  641.                (,RX+1 => RX)
  642.           >>
  643.           UNTIL //BUF[RX]// EQ CR            // there is one 'cos we put one in.
  644.           BUF[POINTER] => RA
  645.      >>
  646.      (,POINTER+1=>POINTER)               // char less parity into ra,inc pointer
  647.      IF EQ CR THEN
  648.      <<
  649.           0-1=>POINTER                // if end of current record, reset pointer
  650.      >>
  651.      // eol is returned to caller to indicate this
  652.      RETURN(RA)
  653.      END
  654.  
  655. //******************************************************************************
  656.  
  657.      ROUTINE FAR_DPRINT(SAVE)                // prints ra as a 8 char int
  658.  
  659.      (,HEXPRINT)
  660.      TOCHAR(,+8,DBUF)
  661.      PUT(LOGSTREAM,8,DBUF)
  662.      RETURN(SAVE)
  663.      END
  664.  
  665. //******************************************************************************
  666.  
  667.      ROUTINE FAR_NX()                        // inhibits n/l on next put
  668.  
  669.      CONTROL(LOGSTREAM,,NOCRLF)
  670.      RETURN
  671.      END
  672.  
  673. //******************************************************************************
  674.  
  675.      ROUTINE FAR_ADDVEC()               // adds the vector message in ry to dbuf
  676.  
  677.      (,=>SAVE,,RY)
  678.      MOVE(,,DBUF+DBUFP)
  679.      (,SAVE+DBUFP=>DBUFP)           // incrementing the pointer for the next one
  680.      RETURN
  681.      END
  682.  
  683. //******************************************************************************
  684.  
  685.      ROUTINE FAR_ADDNUM()       // adds the hex number representing ra into dbuf
  686.  
  687.      TOCHAR(,HEXPRINT+8,DBUF+DBUFP)
  688.      (,DBUFP+8=>DBUFP)           // incrementing the pointer for the next string
  689.      RETURN
  690.      END
  691.  
  692. //******************************************************************************
  693.  
  694.      ROUTINE FAR_PUTVEC()  // writes out the vector created bt addvec and addnum
  695.  
  696.      PUT(LOGSTREAM,DBUFP,DBUF)
  697.      (0=>DBUFP)
  698.      RETURN
  699.      END
  700.  
  701. //******************************************************************************
  702.  
  703.      ROUTINE FAR_DPACK(POINT,NPACK)          // used by debug in r & s pack
  704.      // to print len,num,type to screen
  705.      ADDVEC(,7,POINT)
  706.      ADDVEC(,5,DMESS2)
  707.      ADDNUM(LEN)
  708.      PUTVEC()
  709.      ADDVEC(,7,POINT)
  710.      ADDVEC(,5,DMESS2+5)
  711.      ADDNUM(NPACK)
  712.      PUTVEC()
  713.      ADDVEC(,7,POINT)
  714.      ADDVEC(,5,DMESS2+10)
  715.      ADDNUM(TYPE)
  716.      PUTVEC()
  717.      ADDVEC(,7,POINT)
  718.      ADDVEC(,6,DMESS2+16)
  719.      ADDVEC(,LEN,DATABUF)
  720.      PUTVEC()
  721.      RETURN
  722.      END
  723.  
  724. //******************************************************************************
  725.  
  726.      ROUTINE FAR_CLOSEDOWN                   // shut down all streams, called
  727.                                              // with RA=1 if still physical,
  728.                                              // 0 otherwise
  729.      IF RA NE 0 THEN
  730.      <<
  731.           CLOSE(INSTREAM)
  732.           OPEN(INSTREAM,TEXTIN)              //back to logical
  733.           CONTROL(INSTREAM,,DEFAULT)
  734.           CONTROL(INSTREAM,'C' ALSH 8 +8,ALTCHAR)
  735.                                              // restore backspace
  736.      >>
  737.      CLOSE(INSTREAM)
  738.      CLOSE(OUTSTREAM)
  739.      CLOSE(LOGSTREAM)
  740.      CLOSE(READSTREAM)
  741.      CLOSE(FILESTREAM)
  742.      CLOSE(WITHSTREAM)
  743.      RETURN
  744.      END
  745.  
  746. //******************************************************************************
  747.  
  748.      ROUTINE FAR_RPACK                       // receive packet and decode
  749.  
  750.      WHILE NEXTC() NE STX AND NE HEX'1A' AND NE TIMIDMODE DO CONTINUE
  751.                                              //loop till stx
  752.      IF EQ TIMIDMODE THEN
  753.      <<
  754.           IF LAST_RETRY EQ 2 THEN            // if change of reason for retry
  755.           <<
  756.                // then reset counter
  757.                NUMTRY=>OLDTRY
  758.                0=>NUMTRY
  759.                1=>LAST_RETRY                 // say last retry was timeout
  760.           >>
  761.           RETURN(0)                          // return if timeout
  762.      >>
  763.      IF EQ HEX'1A' THEN
  764.      GOTO FAR_ABORT
  765. RESTART:
  766.      // STX found
  767.      IF NEXTC() EQ STX THEN GOTO RESTART     // if found here then error
  768.      IF EQ TIMIDMODE THEN RETURN (0)
  769.      IF EQ HEX'1A' THEN
  770.      GOTO ABORT
  771.      =>CCHKSUM                               // init chksum
  772.      -' '-3=>LEN                             // unchar and save number of data
  773.      IF LT THEN 0=>LEN                      // if silly small ra prevent neg len
  774.      IF NEXTC() EQ STX THEN GOTO RESTART
  775.      IF EQ TIMIDMODE THEN RETURN(0)
  776.      IF EQ HEX'1A' THEN
  777.      GOTO ABORT
  778.      (,RA -' ' =>NUM)                        // unchar and save packet number
  779.      (+CCHKSUM=>CCHKSUM)                     // add packet number(char)
  780.      IF NEXTC() EQ STX THEN GOTO RESTART
  781.      IF EQ TIMIDMODE THEN RETURN(0)
  782.      IF EQ HEX'1A' THEN
  783.      GOTO ABORT
  784.      (=>TYPE+CCHKSUM=>CCHKSUM)               // save packet type char and add
  785.      0=>I
  786.      WHILE I LT LEN DO                       // loop in data
  787.      <<
  788.           IF NEXTC() EQ STX THEN GOTO RESTART
  789.           IF EQ TIMIDMODE THEN RETURN(0)
  790.           IF LT 0 THEN GOTO BADCHK           // premature end-of-line - treat
  791.                                              //  as bad checksum.
  792.           IF EQ HEX'1A' THEN
  793.           GOTO ABORT
  794.           (=>DATABUF[I]+CCHKSUM=>CCHKSUM)
  795.           I+1=>I
  796.      >>
  797.      0=>DATABUF[I]                           // put marker on end
  798.      IF NEXTC() EQ STX THEN GOTO RESTART
  799.      IF EQ TIMIDMODE THEN RETURN(0)
  800.      IF EQ HEX'1A' THEN
  801.      GOTO ABORT
  802.      IF LT 0 THEN GOTO BADCHK                // premature end-of-line.
  803.      -' '=>RCHKSUM                           // save unchared checksum received
  804.      IF NEXTC() EQ STX THEN GOTO RESTART
  805.      IF EQ TIMIDMODE THEN RETURN(0)
  806.      IF EQ HEX'1A' THEN
  807.      GOTO ABORT
  808.      IF GE 0 THEN GOTO BADCHK                // next chara. should be EOL.
  809.      CCHKSUM & MASK1 LRSH [6]+CCHKSUM & MASK2=>CCHKSUM   // compute my check
  810.      IF DEBUG NE THEN                        // if debug mode print things
  811.      <<
  812.           CALL DPACK(DMESS1,NUM)
  813.      >>
  814.      IF CCHKSUM EQ RCHKSUM THEN              // finished
  815.      RETURN(TYPE)                            // normal return.
  816.  
  817.      // errors.
  818.  
  819. BADCHK:
  820.      // checksums differ or not stated
  821.                                              //  length.
  822.      IF LAST_RETRY EQ 1 THEN                 // if change of reason for retry
  823.      <<
  824.           // then reset counter
  825.           NUMTRY=>OLDTRY
  826.           0=>NUMTRY
  827.           2=>LAST_RETRY                      // say last retry was checksum
  828.      >>
  829.      PUT(LOGSTREAM,25,MESS)                  // say checksum failed
  830.      RETURN(0)
  831.  
  832. ABORT:
  833.      // control-z read.
  834.      PUT(LOGSTREAM,14,ABSTOP)
  835.      CLOSEDOWN(1)
  836.      STOP(1)
  837.      END
  838.  
  839. //******************************************************************************
  840.  
  841.      ROUTINE FAR_SPACK                       // make and send packet
  842.  
  843.      IF DEBUG NE THEN                        // if debug mode print things
  844.      <<
  845.           CALL DPACK(DMESS3,N)
  846.      >>
  847.      (,0)                                    // init rx for count
  848.      WHILE (, LT PAD)  DO
  849.      <<
  850.           PADCAR=>BUF[]                   // put len pad chars into start of buf
  851.           (,+1)
  852.      >>
  853.      STX=>BUF[RX]                            // stx on start of packet
  854.      (,+1)
  855.      LEN+3+' '=>BUF[]=>CCHKSUM               // len+3 chared next
  856.      (,+1)
  857.      N+' '=>BUF[]+CCHKSUM=>CCHKSUM           // followed by n chared, update sum
  858.      (,+1)
  859.      TYPE=>BUF[]+CCHKSUM=>CCHKSUM            // and then type as is
  860.      (,+1)
  861.      0=>I                                    // zero i for count
  862.      RX=>INDEX                               // and remember rx
  863.      WHILE (I LT LEN) DO                     // now insert all data items
  864.      <<
  865.           DATABUF[I]=>BUF[INDEX]+CCHKSUM=>CCHKSUM
  866.           (I+1=>I,+1=>INDEX)
  867.      >>
  868.      // and then do checksum to send
  869.      CCHKSUM & MASK1 LRSH[6] + CCHKSUM & MASK2 +' '=>BUF[INDEX]=>CCHKSUM
  870.      (,+1)
  871.      EOL=>BUF[]                              // finish on eol char
  872.      (,+1=>INDEX)
  873.      IF DEBUG NE THEN                      // Debug now 'cos BUF gets clobbered.
  874.      <<
  875.           ADDVEC(,7,DMESS3)
  876.           ADDVEC(,INDEX,BUF)
  877.           PUTVEC()
  878.      >>
  879.      TEST LISTEN NE THEN
  880.      <<
  881.           // Look for reply immediately.
  882.           CONTROL(INSTREAM,100,PUTGET)       // 100 is GET length
  883.           PUT(INSTREAM,INDEX,BUF)            // and trigger timed
  884.           // GET(INSTREAM,100,BUF)
  885.           TEST RA LT //0// THEN
  886.           <<
  887.                PUT(LOGSTREAM,7,MESSTIME)     // record timeout in log file
  888.                // May have lost controls - re-instate
  889.                CONTROL(INSTREAM,1,STOP_ON_CR)   // terminate gets on cr
  890.                CONTROL(INSTREAM,1,EVEN)      // check and strip even parity
  891.                CONTROL(INSTREAM,TIMEOUT,PGTCODE)   // timeout for put-gets
  892.                1=>TIMING=>SPACK_TIMEOUT  // next call to NEXTC will send timeout
  893.           >>
  894.           // to higher level routine.
  895.           ELSE
  896.           <<
  897.                IF DEBUG NE THEN   PUT(LOGSTREAM,RX,//BUF//)
  898.                                              // write line to logfile
  899.                0=>POINTER                    // so NEXTC picks this buffer up
  900.                =>TIMING
  901.                =>SPACK_TIMEOUT
  902.                CR=>BUF[RX]                 // [RX-1] should be CR,but make sure.
  903.           >>
  904.      >>
  905.      ELSE
  906.      <<
  907.           // Not LISTEN - conventional PUT
  908.           PUT(INSTREAM,INDEX,BUF)
  909.           1=>LISTEN                      // LISTEN unless specifically told not.
  910.           0=>SPACK_TIMEOUT
  911.      >>
  912.      RETURN
  913.      END
  914.  
  915. //******************************************************************************
  916.  
  917.      ROUTINE FAR_RPAR                    // receive parameters from other kermit
  918.                                              // are put into variables
  919.      DATABUF[0]-' '=>SPSIZ
  920.      IF SPSIZ GT 94 THEN 94=>SPSIZ           // dont allow LEN to exceed 94
  921.      DATABUF[+1]-' '=>TIMINT
  922.      IF LE THEN 1                        // make sure cant do very small timeout
  923.      =>TIMEOUT                               // whole secs for timeout
  924.      DATABUF[+1]-' '=>PAD
  925.      DATABUF[+1];(,64 XOR RA=>PADCAR)
  926.      DATABUF[4]-' '=>EOL
  927.      DATABUF[+1]=>QUOTE
  928.      IF LEN GT 6 THEN
  929.      <<
  930.           DATABUF[+1]=>EIGHTQ                // remember his request
  931.           TEST EQ 'Y' THEN MY8BIT=>EIGHTQ    // if Yes then choose myself
  932.           ELSE EIGHTQ=>MY8BIT                // else take his choice.
  933.      >>
  934.      IF LEN GT 7 THEN DATABUF[+1]=>CHKTYPE
  935.      IF LEN GT 8 THEN DATABUF[+1]=>RPEAT=>MYRPEAT
  936.      RETURN
  937.      END
  938.  
  939. //******************************************************************************
  940.  
  941.      ROUTINE FAR_SPAR                        // my requirements to send to local
  942.  
  943.      RPSIZ+' '=>DATABUF[0]
  944.      MYTIME+' '=>DATABUF[+1]
  945.      MYPAD+' '=>DATABUF[+1]
  946.      (MYPCAR,64 XOR RA);RX=>DATABUF[3]
  947.      MYEOL+' '=>DATABUF[+1]
  948.      MYQUOTE=>DATABUF[+1]
  949.      MY8BIT=>DATABUF[+1]
  950.      MYCHECK=>DATABUF[+1]
  951.      MYRPEAT=>DATABUF[+1]
  952.      RETURN
  953.      END
  954.  
  955. //******************************************************************************
  956.  
  957.      ROUTINE FAR_PRERRPKT                    // to print error packet received
  958.  
  959.      PUT(LOGSTREAM,58,ERRVEC)                // with abort message
  960.      PUT(LOGSTREAM,LEN,DATABUF)
  961.      RETURN
  962.      END
  963.  
  964. //******************************************************************************
  965.  
  966.      ROUTINE FAR_RINIT                       // compose and send init packet
  967.      // and get locals parms
  968.      IF NUMTRY GT MAXTRY THEN RETURN ('A')   // if tried too many times give up
  969.      +1=>NUMTRY
  970.      TEST SERVER EQ THEN RPACK()             // if not server get packet
  971.      ELSE TYPE                               // otherwise get packet type
  972.      TEST EQ 'S' THEN                        // if sendinit then set parms
  973.      <<
  974.           RPAR() ; SPAR()                 // put parms in my vars, send my parms
  975.           IF BINFILE NE AND EIGHTQ EQ 'N' THEN
  976.                                              // if binary file check 8bit quote
  977.           <<
  978.                // agreed, if not then abort
  979.                MOVE(,53,DATABUF,MESSYBIT)
  980.                ERROR(,53)
  981.                RETURN('A')
  982.           >>
  983.           'Y'=>TYPE;N=>NUM;9=>LEN            // send ack init
  984.           SPACK()
  985.           NUMTRY=>OLDTRY ; 0=>NUMTRY        // save old try count, start new one
  986.           N+1/64;RB=>N                       // inc packet modulo 64
  987.           RETURN('F')                        // return as state f
  988.      >>
  989.      ELSE
  990.      <<
  991.           TEST EQ 'E' THEN                   // otherwise if error abort
  992.           <<
  993.                PRERRPKT()                    // print error packet received
  994.                RETURN('A')
  995.           >>
  996.           ELSE
  997.           <<
  998.                TEST EQ 0 THEN                // if packet invalid
  999.                <<
  1000.                     'N'=>TYPE;N=>NUM;0=>LEN  // send a nak pak
  1001.                     SPACK()
  1002.                     RETURN(STATE)            // return in same state to retry
  1003.                >>
  1004.                ELSE
  1005.                <<
  1006.                     RETURN('A')              // abort if undefined, cant go on
  1007.                >>
  1008.           >>
  1009.      >>
  1010.      END
  1011.  
  1012. //******************************************************************************
  1013.  
  1014.      ROUTINE ALPHA                           // test if RA is alpha-numeric.
  1015.  
  1016. TEST(  GE '0' AND LE '9')OR( GE 'A' AND LE 'Z')OR( GE 'a' AND LE 'z')THEN  0
  1017.      ELSE TEST EQ '.' OR EQ '%' OR EQ '&' THEN 2
  1018.      ELSE 1
  1019.      RETURN
  1020.      END
  1021.  
  1022. //******************************************************************************
  1023.  
  1024.      ROUTINE FAR_ERROR         // process error, if this is a remote kermit then
  1025.      // send error packet to local screen,
  1026.      TEST REMOTE NE THEN
  1027.      <<
  1028.           MOVE(,=>LEN,DATABUF+11,DATABUF)    // Move up message
  1029.           MOVE(,11,DATABUF,STAMP)            // add in 'kermit-40' stamp
  1030.           (,LEN+11=>LEN)
  1031.           PUT(LOGSTREAM,LEN,DATABUF)         // copy to log file
  1032.           'E'=>TYPE;0=>LISTEN;SPACK()        // may not be expecting reply
  1033.      >>
  1034.      ELSE
  1035.      <<
  1036.           // if local only
  1037.           PRERRPKT()                         // display on this screen.
  1038.      >>
  1039.      RETURN
  1040.      END
  1041.  
  1042. //******************************************************************************
  1043.  
  1044.      ROUTINE HASHFILE
  1045.  
  1046.      // this is the invalid char filter
  1047.  
  1048.      REPEAT
  1049.      <<
  1050.           ALPHA(DATABUF[])                   // alpha/num char??
  1051.           IF NE 1 THEN
  1052.           <<
  1053.                IF EQ 0 OR NORMAL NE 1 THEN   // if so then copy over
  1054.                <<
  1055.                     DATABUF[];(,=>SAVE);=>NEWFILNAM[RY];(,SAVE,+1)
  1056.                >>
  1057.           >>
  1058.           (,+1)                              // next char to check
  1059.      >>
  1060.      UNTIL (,RX EQ LEN)                      // until all copied/filtered
  1061.  
  1062.      (,,RY=>SAVE)                            // store length of NEWFILNAM.
  1063.  
  1064.      // this prunes to size and adds the statutary '.'
  1065.  
  1066.      TEST NORMAL NE THEN                     // if normalform to be done
  1067.      <<
  1068.           IF (,RY GT 8) THEN (,8)            // check max filename size
  1069.           (,=>LEN=>RY)                       // save it as new len, copy to Y
  1070.  
  1071.           // now check that 1st chara of new name isn't a digit.
  1072.           
  1073.           (,SAVE-LEN=>RX)                    // index of 1st chara.
  1074.           WHILE NEWFILNAM[RX] GE '0' AND LE '9' AND (,,RY GT 0) DO
  1075.                (,RX+1,RY-1)
  1076.           TEST (,,RY EQ 0) THEN
  1077.                // all digits. Make 1st an X.
  1078.                'X' => NEWFILNAM[SAVE-LEN]
  1079.                // LEN unchanged.
  1080.              ELSE
  1081.                (,,RY=>LEN)
  1082.  
  1083.           MOVE(,LEN,FILNAM1+1,NEWFILNAM+SAVE-LEN)   // copy it,leaving space for
  1084.           '.'=>FILNAM1[0];LEN+1=>LEN         // period on front
  1085.      >>
  1086.      ELSE                                    // if not normalform
  1087.      <<
  1088.           (,SAVE=>LEN)                       // use full length.
  1089.           MOVE(,,FILNAM1,NEWFILNAM)          // dont leave space for '.'
  1090.      >>
  1091.  
  1092.      /!RAL//  MOVE(,4,FILNAM1+LEN,ATTRIBUTE) // concatenate /add
  1093.      /!RAL//  LEN+4=>LEN
  1094.      /!GEC/!  MOVE(,15,FILNAM1+LEN,ATTRIBUTE)   // /NEW/Z(1,1,127)
  1095.      /!GEC/!  LEN+15=>LEN
  1096.      IF BINFILE NE THEN
  1097.      <<
  1098.           MOVE(,4,FILNAM1+LEN,LSB);LEN+4=>LEN   // move in /lsb
  1099.      >>
  1100.  
  1101.      (,0,LCMASK)
  1102.      REPEAT                                  // convert to upper case loop
  1103.      <<
  1104.           // converts all alphas in line
  1105.           IF FILNAM1[] GT HEX'60' AND LT HEX'7B' THEN & RY  =>FILNAM1[]
  1106.           (,+1)
  1107.      >>
  1108.      UNTIL (,RX EQ LEN)
  1109.  
  1110.      RETURN
  1111.      END
  1112.  
  1113. //******************************************************************************
  1114.  
  1115.      ROUTINE FAR_PRRA
  1116.  
  1117.      ADDVEC(,22,DMANERR)                     // write dm error
  1118.      ADDNUM(SAVERA)
  1119.      PUTVEC()
  1120.      RETURN
  1121.  
  1122.      END
  1123.  
  1124. //******************************************************************************
  1125.  
  1126.      ROUTINE FAR_IOERR                       // Report dman error to logfile &
  1127.      // to remote kermit
  1128.      CALL PRRA                               //write dm error
  1129.      MOVE(,21,DATABUF,DMANERR)         //copy dman message (without final space)
  1130.      // to buf
  1131.      ERROR(,21)                              //send it as error packet
  1132.      RETURN
  1133.  
  1134.      END
  1135.  
  1136. //******************************************************************************
  1137.  
  1138.      ROUTINE RTYPECHECK                      // Rfile filetype checking
  1139.  
  1140.      TEST & DMERRMASK  NE THEN
  1141.      <<
  1142.           // if connect failed
  1143.           CALL PRRA                          // write dm error
  1144.           MOVE(,15,DATABUF,CREFAIL)          // copy fail message to buf
  1145.           MOVE(,LEN,DATABUF+15,FILNAM1)      // add the file name.
  1146.           ERROR(,LEN+15)                     // send it as a error pak
  1147.           RETURN('A')                        // abort
  1148.      >>
  1149.      ELSE
  1150.      <<
  1151.           IF SAVERA & FTYPELS LRSH 16 NE 1 THEN   // check if log sequential
  1152.           <<
  1153.                MOVE(,27,DATABUF,CRETYPE)     // if not complain
  1154.                MOVE(,LEN,DATABUF+27,FILNAM1)
  1155.                ERROR(,LEN+27)
  1156.                PUT(LOGSTREAM,45,DMESS16)
  1157.                RETURN('A')
  1158.           >>
  1159.  
  1160.           TEST BINFILE EQ THEN               // if textfile check matches
  1161.           <<
  1162.                IF SAVERA & FTYPETB EQ THEN   // any existing filetype
  1163.                <<
  1164.                     MOVE(,27,DATABUF,CRETEXT)   // if not complain
  1165.                     MOVE(,LEN,DATABUF+27,FILNAM1)
  1166.                     ERROR(,LEN+27)
  1167.                     PUT(LOGSTREAM,45,DMESS16)
  1168.                     RETURN('A')
  1169.                >>
  1170.                OPEN(FILESTREAM,TXOUT_ERR,ERROPT)   // open a text file
  1171.           >>
  1172.           ELSE
  1173.           <<
  1174.                IF SAVERA & FTYPETB NE THEN   // if binary file check
  1175.                <<
  1176.                     // against any existing
  1177.                     MOVE(,29,DATABUF,CREBIN) // file and complain if
  1178.                     MOVE(,LEN,DATABUF+29,FILNAM1)   // non matching
  1179.                     ERROR(,LEN+29)
  1180.                     PUT(LOGSTREAM,45,DMESS16)
  1181.                     RETURN('A')
  1182.                >>
  1183.  
  1184.                OPEN(FILESTREAM,BINOUT_ERR,ERROPT)   // else open a binary file
  1185.           >>
  1186.      >>
  1187.      RETURN
  1188.      END
  1189.  
  1190. //******************************************************************************
  1191.  
  1192.      ROUTINE FAR_FILE_DE_PREFIX              // deprefix file paks
  1193.  
  1194.      0=>J
  1195.      UNTIL(,J EQ LEN) DO                     // de_prefix it
  1196.      <<
  1197.           CALL DE_PREFIX
  1198.           (,RCOUNT=>I)                       // set I for repeat count
  1199.           WHILE (, GT 1) DO                  // loop if repeating
  1200.           <<
  1201.                DATABUF[J]=>BUFFER[IB]        // put last char in again
  1202.                (,+1=>IB)
  1203.                (,I-1=>I)                     // and repeat loop
  1204.           >>
  1205.           (,1=>RCOUNT)                       // reset
  1206.           (,J+1=>J)                          // next char
  1207.      >>
  1208.      IB=>LEN
  1209.      RETURN
  1210.      END
  1211.  
  1212. //******************************************************************************
  1213.  
  1214.      ROUTINE FAR_RFILE                       //  rx file header
  1215.  
  1216.      IF NUMTRY GT MAXTRY THEN RETURN('A')    // abort if too many tries
  1217.      +1=>NUMTRY
  1218.      RPACK()                                 // get a packet
  1219.      TEST EQ 'S' THEN                        // sendinit, ie our ack lost
  1220.      <<
  1221.                                              // if so send again
  1222.           IF OLDTRY GT MAXTRY THEN RETURN('A')   // too many retries?
  1223.           +1=>OLDTRY
  1224.           TEST N EQ THEN 63                  // if not out of sequence mod 64
  1225.           ELSE -1                            //   with out packet number
  1226.           TEST EQ NUM THEN                   // then send our inits again
  1227.           <<
  1228.                N=>NEXTN;NUM=>N
  1229.                SPAR()
  1230.                'Y'=>TYPE;9=>LEN;SPACK();NEXTN=>N
  1231.                0=>NUMTRY                     // reset counter
  1232.                RETURN(STATE)                 // same state
  1233.           >>
  1234.           ELSE
  1235.           <<
  1236.                RETURN('A')                   // otherwise abort
  1237.           >>
  1238.      >>
  1239.      ELSE
  1240.      <<
  1241.           TEST EQ 'Z' THEN                   // could be eof
  1242.           <<
  1243.                IF OLDTRY GT MAXTRY THEN RETURN('A')   // if too many tries abort
  1244.                +1=>OLDTRY
  1245.                TEST N EQ THEN 63             // if not out of sequence mod 64
  1246.                ELSE -1                       //   with out packet number
  1247.                TEST EQ NUM THEN              // ok  so ack it
  1248.                <<
  1249.                     N=>NEXTN;NUM=>N
  1250.                     'Y'=>TYPE;0=>LEN;SPACK();NEXTN=>N
  1251.                     0=>NUMTRY
  1252.                     RETURN(STATE)
  1253.                >>
  1254.                ELSE
  1255.                <<
  1256.                     RETURN('A')              // no so abort
  1257.                >>
  1258.           >>
  1259.           ELSE
  1260.           <<
  1261.                TEST EQ 'F' THEN              // file header, this is
  1262.                <<
  1263.                                              // what we want
  1264.                     IF NUM NE N THEN RETURN('A')   // correct packet number?
  1265.  
  1266.                     CALL FILE_DE_PREFIX      // de prefix the f pak
  1267.                     IF NPARMS EQ OR SERVER NE THEN   // if no filename parm
  1268.                     <<
  1269.                          // or if so but is server
  1270.                          MOVE(,LEN,DATABUF,BUFFER)
  1271.                          (,0,0)              // hash to valid name
  1272.                                              // whatever is in databuf
  1273.                          HASHFILE()
  1274.                     >>
  1275.                     IF NPARMS NE AND SERVER EQ THEN
  1276.                                              // if not server and a file
  1277.                     <<
  1278.                          // name was given
  1279.                          MOVE(,LF=>LEN,FILNAM1,FILNAM)
  1280.                          /!RAL//     MOVE(,4,FILNAM1+LEN,ATTRIBUTE)
  1281.                                              // concatenate /add
  1282.                          /!RAL//     LEN+4=>LEN
  1283.                          /!GEC/!     MOVE(,15,FILNAM1+LEN,ATTRIBUTE)
  1284.                                              // /NEW/Z(1,1,127)
  1285.                          /!GEC/!     LEN+15=>LEN
  1286.                          IF BINFILE NE THEN
  1287.                          <<
  1288.                               MOVE(,4,FILNAM1+LEN,LSB);LEN+4=>LEN
  1289.                                              // move in /lsb
  1290.                          >>
  1291.                     >>
  1292.  
  1293.                     ADDVEC(,IB,BUFFER)       // then this to be used
  1294.                     ADDVEC(,14,RXMESS)
  1295.                     ADDVEC(,LEN,FILNAM1)     // show what name received
  1296.                     PUTVEC()                 // as.
  1297.                     0=>IB
  1298.                     /!GEC/!  DMCONNECT(FILESTREAM,0,0)
  1299.                     DMCONNECT(FILESTREAM,LEN,FILNAM1) =>SAVERA
  1300.                     CALL RTYPECHECK          // check filetypes etc
  1301.                     IF EQ 'A' THEN RETURN(RA)   // if abort return
  1302.                     'Y'=>TYPE;0=>LEN;SPACK() // ack it
  1303.                     NUMTRY=>OLDTRY
  1304.                     0=>NUMTRY
  1305.                     N+1/64;RB=>N             // next packet number
  1306.                     RETURN('D')              // return for data
  1307.  
  1308.                >>
  1309.                ELSE
  1310.                <<
  1311.                     TEST EQ 'B' THEN         // break transmission eot
  1312.                     <<
  1313.                          IF NUM NE N THEN RETURN('A')   // check packet number
  1314.                          'Y'=>TYPE;0=>LEN=>LISTEN;SPACK()   // ack  ok
  1315.                          RETURN('C')         // return complete
  1316.                     >>
  1317.                     ELSE
  1318.                     <<
  1319.                          TEST EQ 'E' THEN    // if error packet
  1320.                          <<
  1321.                               PRERRPKT()     // print it
  1322.                               RETURN('A')
  1323.                          >>
  1324.                          ELSE
  1325.                          <<
  1326.                               TEST EQ 0 THEN // if checksum error
  1327.                               <<
  1328.                                    'N'=>TYPE;0=>LEN;SPACK()   // nak it
  1329.                                    RETURN(STATE)   // retry
  1330.                               >>
  1331.                               ELSE
  1332.                               <<
  1333.                                    RETURN('A')   // anything else, abort
  1334.                               >>
  1335.                          >>
  1336.                     >>
  1337.                >>
  1338.           >>
  1339.      >>
  1340.      RETURN
  1341.      END
  1342.  
  1343. //******************************************************************************
  1344.  
  1345.      ROUTINE RDATA                           // rx data
  1346.  
  1347.      IF NUMTRY GT MAXTRY THEN RETURN('A')    // abort if too many tries
  1348.      +1=>NUMTRY
  1349.      RPACK()                                 // get a packet
  1350.      TEST EQ 'D' THEN                        // data packet?
  1351.      <<
  1352.           IF NUM NE N THEN                   // new packet?
  1353.           <<
  1354.                IF OLDTRY GT MAXTRY THEN RETURN('A')   // too many retries?
  1355.                +1=>OLDTRY
  1356.                TEST N EQ THEN 63             // if not out of sequence mod 64
  1357.                ELSE -1                       //   with out packet number
  1358.                TEST EQ NUM THEN              // in sequence so
  1359.                <<
  1360.                     N=>NEXTN;NUM=>N
  1361.                     'Y'=>TYPE;0=>LEN;SPACK();NEXTN=>N   // ack it
  1362.                     0=>NUMTRY                // reset counter
  1363.                     RETURN(STATE)            // same state
  1364.                >>
  1365.                ELSE                          // not in seq
  1366.                <<
  1367.                     RETURN('A')              // so abort
  1368.                >>
  1369.           >>
  1370.           BUFEMP()                           // write to file
  1371.           IF RA EQ 'A' THEN RETURN(RA)       // pass on any errors.
  1372.           'Y'=>TYPE;0=>LEN;SPACK()           // ack it
  1373.           NUMTRY=>OLDTRY
  1374.           0=>NUMTRY
  1375.           N+1/64;RB=>N
  1376.           RETURN('D')                        // return for data
  1377.      >>
  1378.      ELSE
  1379.      <<
  1380.           TEST EQ 'F' THEN                   // if file packet
  1381.           <<
  1382.                IF OLDTRY GT MAXTRY THEN RETURN('A')   // if too many tries abort
  1383.                +1=>OLDTRY
  1384.                TEST N EQ THEN 63             // if not out of sequence mod 64
  1385.                ELSE -1                       //   with out packet number then
  1386.                TEST EQ NUM THEN              //   ack it
  1387.                <<
  1388.                     N=>NEXTN;NUM=>N
  1389.                     'Y'=>TYPE;0=>LEN;SPACK();NEXTN=>N
  1390.                     0=>NUMTRY
  1391.                     RETURN(STATE)
  1392.                >>
  1393.                ELSE
  1394.                <<
  1395.                     RETURN('A')              // no so abort
  1396.                >>
  1397.           >>
  1398.           ELSE
  1399.           <<
  1400.                TEST EQ 'Z' THEN              // is it eof
  1401.                <<
  1402.                     IF NUM NE N THEN RETURN('A')   // correct packet number?
  1403.                     'Y'=>TYPE;0=>LEN;SPACK()
  1404.                     IF IB NE THEN
  1405.                     <<
  1406.                          PUT(FILESTREAM,IB,0=>IB+BUFFER)
  1407.                                              //make sure buffer emptied
  1408.                          IF RA LT //0// THEN
  1409.                          <<
  1410.                               =>SAVERA
  1411.                               IOERR()        // report dman error
  1412.                               RETURN('A')
  1413.                          >>
  1414.                     >>
  1415.                     CLOSE(FILESTREAM,0)      // ack and close file
  1416.                     0=>NPARMS                // in case other end sends >1 file.
  1417.                     N+1/64;RB=>N
  1418.                     RETURN('F')              // return for next file
  1419.                >>
  1420.                ELSE
  1421.                <<
  1422.                     TEST EQ 'E' THEN         // if error packet
  1423.                     <<
  1424.                          PRERRPKT()          // print it
  1425.                          RETURN('A')
  1426.                     >>
  1427.                     ELSE
  1428.                     <<
  1429.                          TEST EQ 0 THEN      // if checksum error
  1430.                          <<
  1431.                               'N'=>TYPE;0=>LEN;SPACK()   // nak it
  1432.                               RETURN(STATE)  // retry
  1433.                          >>
  1434.                          ELSE
  1435.                          <<
  1436.                               RETURN('A')    // anything else, abort
  1437.                          >>
  1438.                     >>
  1439.                >>
  1440.           >>
  1441.      >>
  1442.      RETURN
  1443.      END
  1444.  
  1445. //******************************************************************************
  1446.  
  1447.      ROUTINE FAR_DE_PREFIX                   // copy to BUFFER decoding on the
  1448.                                              // way.
  1449.      IF RPEAT NE ' ' AND DATABUF[J] EQ RPEAT THEN
  1450.      <<
  1451.           DATABUF[+1=>J]-' '=>RCOUNT         // if repeat then set count
  1452.           (,+1=>J)
  1453.      >>
  1454.                                              // if quoting deal with 8bit
  1455.      IF EIGHTQ NE 'N' AND DATABUF[J] EQ EIGHTQ THEN (1=>FLAG8,+1=>J)
  1456.                                              // remember flag
  1457.  
  1458.      IF DATABUF[J] EQ QUOTE THEN             // control quote?
  1459.  
  1460.      <<
  1461.           IF DATABUF[J+1=>J] NE QUOTE AND NE MY8BIT AND NE MYRPEAT THEN
  1462.                                              // if so and next char not
  1463.           <<
  1464.                                              // a quote char
  1465.                (,,HEX'BF' & RA=>RA)          // then controllify it
  1466.                IF EQ HEX '3F' THEN + 64      // if ? then make ff
  1467.           >>
  1468.      >>
  1469.      IF (,IMAGE NE OR RA NE HEX '0A' OR BINFILE NE) THEN
  1470.      <<
  1471.           // only if image mode or binfile or not lf
  1472.           IF (,BINFILE NE AND FLAG8 NE )THEN (+128,,0=>FLAG8)
  1473.                                              // if binary wants 8th bit
  1474.           =>BUFFER[IB]                       // write char to file buffer
  1475.           (,+1=>IB)
  1476.      >>
  1477.      =>DATABUF[J]                            // Store here in case repeating
  1478.      RETURN
  1479.      END
  1480.  
  1481. //******************************************************************************
  1482.  
  1483.      ROUTINE BUFEMP                          // write data buffer to file
  1484.  
  1485.      0=>J                                    // init counter
  1486.      UNTIL (,J EQ LEN) DO                    // loop through data
  1487.      <<
  1488.           CALL DE_PREFIX                     // De prefix to buffer
  1489.           (,RCOUNT=>I)                       // set I for repeat count
  1490.           WHILE (, GE 1) DO                  // loop incase repeating
  1491.           <<
  1492.                                              // if text put when cr found
  1493.                TEST EQ HEX'0D' AND BINFILE EQ THEN
  1494.                <<
  1495.                     PUT(FILESTREAM,IB-1,0=>IB+BUFFER)
  1496.                     IF RA LT //0// THEN
  1497.                     <<
  1498.                          =>SAVERA
  1499.                          IOERR()             // report dman error
  1500.                          RETURN('A')
  1501.                     >>
  1502.                >>
  1503.                                              // if binary put every 235
  1504.                ELSE IF IB GE 235 THEN
  1505.                <<
  1506.                     PUT(FILESTREAM,IB,0=>IB+BUFFER)
  1507.                                              // reset IB for next line
  1508.                     IF RA LT //0// THEN
  1509.                     <<
  1510.                          =>SAVERA
  1511.                          IOERR()             // report dman error
  1512.                          RETURN('A')
  1513.                     >>
  1514.                >>
  1515.                IF (,I GT 1) THEN             // if repeating
  1516.                <<
  1517.                     DATABUF[J]=>BUFFER[IB]   // put last char in again
  1518.                     (,+1=>IB)
  1519.                >>
  1520.                (,I-1=>I)                     // and repeat loop
  1521.           >>
  1522.           (,1=>RCOUNT)
  1523.           (,J+1=>J)
  1524.      >>
  1525.      RETURN(1)                      // (1) just in case last chara. read was 'A'
  1526.      END
  1527.  
  1528. //******************************************************************************
  1529.  
  1530.      ROUTINE FAR_RECSW                      // state table switcher for rx files
  1531.  
  1532.      0=>N=>NUMTRY=>IB                     // init packet number and no tries yet
  1533.      'R'=>STATE                              // start state
  1534.  
  1535.      REPEAT                                  // always loop
  1536.      <<
  1537.           IF DEBUG NE THEN
  1538.           <<
  1539.                STATE=>DMESS4[14]
  1540.                PUT(LOGSTREAM,15,DMESS4)
  1541.           >>
  1542.           TEST STATE EQ 'R' THEN
  1543.           <<
  1544.                RINIT()=>STATE                // receive init
  1545.           >>
  1546.           ELSE
  1547.           <<
  1548.                TEST EQ 'F' THEN
  1549.                <<
  1550.                     RFILE()=>STATE           // receive file
  1551.                >>
  1552.                ELSE
  1553.                <<
  1554.                     TEST EQ 'D' THEN
  1555.                     <<
  1556.                          RDATA()=>STATE      // receive data
  1557.                     >>
  1558.                     ELSE
  1559.                     <<
  1560.                          TEST EQ 'C' THEN
  1561.                          <<
  1562.                               RETURN(1)      // completed state
  1563.                          >>
  1564.                          ELSE
  1565.                          <<
  1566.                               CLOSE(FILESTREAM)   // must be 'a'
  1567.                               RETURN(0)      // abort state
  1568.                          >>
  1569.                     >>
  1570.                >>
  1571.           >>
  1572.      >>
  1573.      ALWAYS
  1574.      END
  1575.  
  1576. //******************************************************************************
  1577.  
  1578.      ROUTINE FAR_SINIT                     // send initialise, send my parms get
  1579.      // locals parms
  1580.      IF NUMTRY GT MAXTRY THEN RETURN('A')    // if too many tries give up
  1581.      +1=>NUMTRY
  1582.      SPAR()                                  // fill up init info pak
  1583.      IF SERVER EQ THEN                      // if not server assume slow fingers
  1584.      <<
  1585.           SEND(DELAY,1,0,TIMEVENT)         // wait for delay before sending init
  1586.           WAIT(,,,TIMEVENT)
  1587.      >>
  1588.      'S'=>TYPE;9=>LEN;SPACK()
  1589.      TEST RPACK() EQ 'N' THEN
  1590.      <<
  1591.           RETURN(STATE)                      // send s packet and what response?
  1592.      >>
  1593.      ELSE                                    // not nak so try if ack??
  1594.      <<
  1595.           TEST EQ 'Y' THEN
  1596.           <<
  1597.                IF N NE NUM THEN RETURN(STATE)
  1598.                                              // if wrong ack stay in same state
  1599.                RPAR()                        // get her parms
  1600.                IF BINFILE NE AND EIGHTQ EQ 'N' THEN
  1601.                <<
  1602.                     // if binary file and quoting not agreed
  1603.                     MOVE(,53,DATABUF,MESSYBIT)
  1604.                     ERROR(,53)               // abort with error pak and message
  1605.                     RETURN('A')
  1606.                >>
  1607.                0=>NUMTRY
  1608.                N+1/64;RB=>N
  1609.                RETURN(F_OR_X_FLAG)           // return for file or text
  1610.           >>
  1611.           ELSE
  1612.           <<
  1613.                TEST EQ 'E' THEN              // deal with error packet
  1614.                <<
  1615.                     PRERRPKT ()
  1616.                     RETURN('A')
  1617.                >>
  1618.                ELSE
  1619.                <<
  1620.                     TEST EQ 0 THEN           // checksum error? so retry
  1621.                     <<
  1622.                          RETURN(STATE)
  1623.                     >>
  1624.                     ELSE
  1625.                     <<
  1626.                          // must be unknown
  1627.                          RETURN('A')         // anything else, cant go on
  1628.                     >>
  1629.                >>
  1630.           >>
  1631.      >>
  1632.      END
  1633.  
  1634. //******************************************************************************
  1635.  
  1636.      ROUTINE FAR_SFILE                       // send file or text header
  1637.  
  1638.      IF NUMTRY GT MAXTRY THEN RETURN('A')    // if too many tries give up
  1639.      +1=>NUMTRY                              // next try
  1640.      IF FP EQ THEN                           // if not already open
  1641.      <<
  1642.           IF DEBUG NE THEN
  1643.           <<
  1644.                ADDVEC(,34,DMESS5)
  1645.                ADDVEC(,LF,FILNAM)
  1646.                PUTVEC()
  1647.           >>
  1648.           DMCONNECT(READSTREAM,LF,FILNAM) =>SAVERA
  1649.           IF & DMERRMASK NE THEN
  1650.           <<
  1651.                // if connect fails then report
  1652.                CALL PRRA                     // write dm error
  1653.                MOVE(,17,DATABUF,READFAIL)
  1654.                MOVE(,LF,DATABUF+17,FILNAM)
  1655.                ERROR(,LF+17)
  1656.                RETURN('A')
  1657.           >>
  1658.           IF SAVERA & FTYPELS LRSH 16 NE 1 THEN   // check if log sequential
  1659.           <<
  1660.                MOVE(,27,DATABUF,CRETYPE)     // if not complain
  1661.                MOVE(,LF,DATABUF+27,FILNAM)
  1662.                ERROR(,LF+27)
  1663.                PUT(LOGSTREAM,45,DMESS16)
  1664.                RETURN('A')
  1665.           >>
  1666.  
  1667.           TEST BINFILE EQ THEN               // if textfile then check
  1668.           <<
  1669.                // any existing file for type
  1670.                IF SAVERA & FTYPETB EQ THEN   // lst
  1671.                <<
  1672.                     MOVE(,27,DATABUF,CRETEXT)   // if not complain
  1673.                     MOVE(,LF,DATABUF+27,FILNAM)
  1674.                     ERROR(,LF+27)
  1675.                     PUT(LOGSTREAM,45,DMESS16)
  1676.                     RETURN('A')
  1677.                >>
  1678.                OPEN(READSTREAM,TXIN_ERR,ERROPT)   // open file if text
  1679.           >>
  1680.           ELSE
  1681.           <<
  1682.                IF SAVERA & FTYPETB NE THEN   // otherwise check binary type
  1683.                <<
  1684.                     MOVE(,29,DATABUF,CREBIN) // if not complain
  1685.                     MOVE(,LEN,DATABUF+29,FILNAM)
  1686.                     ERROR(,LEN+29)
  1687.                     PUT(LOGSTREAM,45,DMESS16)
  1688.                     RETURN('A')
  1689.                >>
  1690.                OPEN(READSTREAM,BININ_ERR,ERROPT)   // open file if binary
  1691.           >>
  1692.           0=>EOFPENDING=>BINEOF              // init flag
  1693.           1=>FP                              // remember opened
  1694.      >>
  1695.      MOVE(,LF,FILNAM1,FILNAM)                // move filename
  1696.      (,0)                                    // init count
  1697.      FILNAM1=>NEWFILNAM                      // set to same in case no gec '.'
  1698.      LF=>LEN
  1699.      IF NORMAL NE THEN                       // if normal-form then truncate so
  1700.      <<
  1701.           WHILE (,RX NE LF) DO           // look for last level in cat structure
  1702.           <<
  1703.                IF FILNAM1[] EQ '.' OR EQ '%' OR EQ '&'THEN
  1704.                <<
  1705.                     // catalogue separator found
  1706.                     FILNAM1+RX+1=>NEWFILNAM  // remember as the latest lowest??
  1707.                     LF-RX-1=>LEN       // calculate length left(length of name?)
  1708.                >>
  1709.                (,+1)                         // carry on looking
  1710.           >>
  1711.      >>
  1712.  
  1713.      ADDVEC(,8,SENDMESS)
  1714.      ADDVEC(,LF,FILNAM)
  1715.      ADDVEC(,4,SENDMESS+7)                   // show what file is being sent as
  1716.      ADDVEC(,LEN,NEWFILNAM)
  1717.      PUTVEC()
  1718.      (,0=>I=>J)
  1719.      WHILE (,LT LEN) DO
  1720.      <<
  1721.           NEWFILNAM[]
  1722.           EN_PREFIX()
  1723.           (,J+1=>J)
  1724.      >>
  1725.      I=>LEN
  1726.      F_OR_X_FLAG=>TYPE;MOVE(,LEN,DATABUF,BUFFER);SPACK()   // send f or x packet
  1727.      TEST RPACK() EQ 'N' THEN                // get reply
  1728.      <<
  1729.           IF (NUM-1=>NUM LT 0) THEN 63=>NUM  // if nak stay in this state
  1730.           IF N NE NUM THEN RETURN(STATE)     // unless nak from next packet
  1731.           GOTO Y                             // which means ack for this
  1732.      >>
  1733.                                              // packet so fall through
  1734.      ELSE
  1735.      <<
  1736.           TEST EQ 'Y' THEN
  1737.           <<
  1738.                IF N NE NUM THEN RETURN (STATE)   // if wrong ack stay in f state
  1739. Y:
  1740.                0=>NUMTRY                     // reset try counter
  1741.                N+1/64;RB=>N                  // bump packet count
  1742.                BUFILL()=>SIZE                // get first data from file
  1743.                IF GE THEN RETURN('D')        // return for data state
  1744.                IF +1 EQ THEN RETURN('Z')     // check for eof(-1)
  1745.                RETURN('A')                   // return for io error
  1746.           >>
  1747.           ELSE
  1748.           <<
  1749.                TEST EQ 'E' THEN
  1750.                <<
  1751.                     // deal with error packet
  1752.                     PRERRPKT()
  1753.                     RETURN('A')
  1754.                >>
  1755.                ELSE
  1756.                <<
  1757.                     TEST EQ 0 THEN           // receive fail so stay state
  1758.                     <<
  1759.                          RETURN(STATE)
  1760.                     >>
  1761.                     ELSE
  1762.                     <<
  1763.                          RETURN('A')         // else abort
  1764.                     >>
  1765.                >>
  1766.           >>
  1767.      >>
  1768.      END
  1769.  
  1770. //******************************************************************************
  1771.  
  1772.      ROUTINE GETC                            // get next char from file
  1773.                                              // similar to nextc
  1774.      IF GP LT AND REREAD EQ THEN
  1775.      <<
  1776.           0=>EOFLAG                          // always set default assumption
  1777.           REPEAT
  1778.           <<
  1779.                IF BINEOF EQ THEN             // if not had eof in binfile
  1780.                <<
  1781.                     GET(READSTREAM,INBUFLEN,INBUF) => SAVERA   // read new line
  1782.                     (,=>RECLEN)
  1783.                >>
  1784.                IF RA LT 0 OR (,BINEOF NE)  THEN
  1785.                TEST & EOFMASK EQ EOF OR BINEOF NE THEN   // if had eof
  1786.                <<
  1787.                     1 =>EOFLAG               // set end of file
  1788.                     -2=>GP
  1789.                     RETURN(0)
  1790.                >>
  1791.                ELSE
  1792.                <<
  1793.                     // dman error
  1794.                     IOERR()                  // error already in SAVERA
  1795.                     RETURN(0-2)
  1796.                >>
  1797.           >>
  1798.           UNTIL BINFILE EQ OR RECLEN NE      // until non null record if binary
  1799.           IF BINFILE EQ THEN                 // if text then add return
  1800.           <<
  1801.                CR=>INBUF[RECLEN]
  1802.                (,+1=>RECLEN)
  1803.           >>
  1804.           0=>GP                              // pointer to start
  1805.      >>
  1806.      INBUF[GP]                               // get the next char
  1807.      IF (,IMAGE EQ AND BINFILE EQ) THEN & MASK   // if not image mode mask bit 8
  1808.      (,GP+1=>GP)
  1809.      IF (,GE RECLEN) THEN (,0=>REREAD-1=>GP) // if end of record reset
  1810.      RETURN(RA)
  1811.      END
  1812.  
  1813. //******************************************************************************
  1814.  
  1815.      // This area is very hacked to get repeat counting to work in binfiles
  1816.  
  1817.      ROUTINE EN_PREFIX                    // char in RA to BUFFER with prefixing
  1818.  
  1819.      IF (,RA NE CR AND RPEAT NE ' ' AND STATE NE 'S') THEN   // if repeat agreed
  1820.      <<
  1821.           =>SAVE                          // this is the repeat count prefix bit
  1822.           WHILE GETC() EQ SAVE AND EOFLAG EQ AND RCOUNT LT 94 DO
  1823.           RCOUNT+1=>RCOUNT
  1824.           // if next char same count it
  1825.           IF EOFLAG NE AND BINFILE NE THEN 0=>RECLEN+1=>GP
  1826.                                              // Fix reclen if binary eof
  1827.           GP-1=>GP                           // either way reset GETC
  1828.           IF LT AND REREAD EQ THEN RECLEN-1=>GP
  1829.                                              // cater for last on line in GETC
  1830.           IF RCOUNT GT 1 THEN                // if more than 1
  1831.           <<
  1832.                TEST LT 4 THEN                // then if too few dont do
  1833.                <<
  1834.                     (,GP-RA+1=>GP-GP)        // Reset GETC and set rx zero
  1835.                     IF GP LT THEN          // Carry down to PREBUF (only happens
  1836.                     <<
  1837.                          // if binary)
  1838.                          REPEAT
  1839.                          SAVE=>INBUF[-1] // Put the SAVE char in, rcount times-1
  1840.                          UNTIL (, EQ GP)
  1841.                          1=>REREAD           // set flag to tell GETC
  1842.                          IF EOFLAG NE THEN
  1843.                          <<
  1844.                               0=>EOFLAG=>RECLEN+1=>BINEOF
  1845.                                              // if endof file put it off till
  1846.                                              // done
  1847.                          >>
  1848.                          // the carry over.
  1849.                     >>
  1850.                >>
  1851.                ELSE
  1852.                <<
  1853.                     MYRPEAT=>BUFFER[I];(,+1=>I)   // insert repeat count prefix
  1854.                     RCOUNT+' '=>BUFFER[I];(,+1=>I)   // insert count chared
  1855.                >>
  1856.                1=>RCOUNT
  1857.           >>
  1858.           SAVE                           // and restore RA then continue as norm
  1859.      >>
  1860.      IF (,EIGHTQ NE 'N' AND RA GT 127) THEN  // if quoting and 8 bit set
  1861.      <<
  1862.           // then put in 8bit quote
  1863.           (,,RA)
  1864.           MY8BIT=>BUFFER[I];(,+1=>I)
  1865.           (RY & 127)                         // now loose top bit
  1866.      >>
  1867.  
  1868.  
  1869.      IF LT ' ' OR EQ HEX'7F' OR EQ MYQUOTE OR EQ MY8BIT OR EQ MYRPEAT THEN
  1870.      //  is control handling needed?
  1871.      <<
  1872.           IF(,RA NE MY8BIT OR EIGHTQ NE 'N') THEN
  1873.           <<
  1874.                IF (,RA NE MYRPEAT OR RPEAT NE ' ')THEN
  1875.                <<
  1876.                     IF EQ 13 AND (,IMAGE EQ) AND (,BINFILE EQ) THEN
  1877.                     // if cr and not image mode do
  1878.                     <<
  1879.                          MYQUOTE=>BUFFER[I];(,+1=>I)   // quote it
  1880.                          (13,64 XOR RA);RX=>BUFFER[I];(,+1=>I)
  1881.                          10                  // next send lf
  1882.                     >>
  1883.                     (,,RA)
  1884.                     MYQUOTE=>BUFFER[I];(,+1=>I)   // put control quote in
  1885.                     (RY)
  1886.                     IF NE MYQUOTE AND NE MY8BIT AND NE MYRPEAT THEN
  1887.                                              // if not a quote char
  1888.                     <<
  1889.                          (,64 XOR RY=>RA)    // uncontrolify
  1890.                     >>
  1891.                >>
  1892.           >>
  1893.      >>
  1894.      TEST (,IMAGE NE) THEN                   // deposit the char
  1895.      <<
  1896.           =>BUFFER[I];(,+1=>I)
  1897.      >>
  1898.      ELSE
  1899.      <<
  1900.           =>BUFFER[I];(,+1=>I)               // same for now
  1901.      >>
  1902.      RETURN
  1903.      END
  1904.  
  1905. //******************************************************************************
  1906.  
  1907.      ROUTINE FAR_BUFILL                      // get bufferfull of data
  1908.                                              // with control quoting only
  1909.      0=>I
  1910.      IF EOFPENDING EQ THEN
  1911.      <<
  1912.           WHILE  GETC() GE 0 AND (,EOFLAG EQ ) DO
  1913.                                              // for not eof (getc always
  1914.                                              // positive)
  1915.           <<
  1916.                CALL EN_PREFIX                // do any prefixing to buffer
  1917.                IF SPSIZ-7 LE I THEN RETURN(I)   // check buffer full??
  1918. // Allow 4 for 5 more chars possible after I=spsiz-8. And 3 for Mark,Len and
  1919.                // Check.
  1920.           >>
  1921.           IF //GETC// LT 0 THEN              // reset C reg
  1922.           RETURN(RA)                         // -2 flags dman error
  1923.      >>
  1924.      IF I EQ THEN RETURN(0-1)                // must be eof so set -1
  1925.      1=>EOFPENDING                           // remember on next entry
  1926.      RETURN(I)                               // that eof was found
  1927.  
  1928.      END
  1929.  
  1930. //******************************************************************************
  1931.  
  1932.      ROUTINE FAR_SDATA                       // send file data
  1933.  
  1934.      IF NUMTRY GT MAXTRY THEN RETURN('A')    // if too many tries give up
  1935.      +1=>NUMTRY
  1936.      'D'=>TYPE;SIZE=>LEN;MOVE(,LEN,DATABUF,BUFFER);SPACK()   // send d packet
  1937.      RPACK()
  1938.      TEST EQ 'N' THEN
  1939.      <<
  1940.           IF (NUM-1=>NUM LT 0) THEN 63=>NUM  // if nak stay in this state
  1941.           IF N NE NUM THEN RETURN(STATE)     // unless nak from next packet
  1942.           GOTO Z                             // which means ack for this
  1943.      >>
  1944.                                              // packet so fall through
  1945.      ELSE
  1946.      <<
  1947.           TEST EQ 'Y' THEN
  1948.           <<
  1949.                IF N NE NUM THEN RETURN (STATE)   // if wrong ack stay in f state
  1950. Z:
  1951.                0=>NUMTRY                     // reset try counter
  1952.                N+1/64;RB=>N                  // bump packet count
  1953.                BUFILL()=>SIZE                // get data from file
  1954.                IF GE THEN RETURN('D')        // remain in data state
  1955.                IF +1 EQ THEN RETURN('Z')     // if end of file return so
  1956.                RETURN('A')                   // return for io error
  1957.           >>
  1958.           ELSE
  1959.           <<
  1960.                TEST EQ 'E' THEN
  1961.                <<
  1962.                     // deal with error packet
  1963.                     PRERRPKT()
  1964.                     RETURN('A')
  1965.                >>
  1966.                ELSE
  1967.                <<
  1968.                     TEST EQ 0 THEN           // receive fail so stay state
  1969.                     <<
  1970.                          RETURN(STATE)
  1971.                     >>
  1972.                     ELSE
  1973.                     <<
  1974.                          RETURN('A')         // else abort
  1975.                     >>
  1976.                >>
  1977.           >>
  1978.      >>
  1979.      END
  1980.  
  1981. //******************************************************************************
  1982.  
  1983.      ROUTINE FAR_SEOF                        // send end-of-file
  1984.  
  1985.      IF NUMTRY GT MAXTRY THEN RETURN('A')    // if too many tries give up
  1986.      +1=>NUMTRY
  1987.      'Z'=>TYPE;SPACK()                       // send z packet
  1988.      RPACK()
  1989.      TEST EQ 'N' THEN
  1990.      <<
  1991.           IF (NUM-1=>NUM LT 0) THEN 63=>NUM  // if nak stay in this state
  1992.           IF N NE NUM THEN RETURN(STATE)     // unless nak from next packet
  1993.           GOTO Z2                            // which means ack for this
  1994.      >>
  1995.                                              // packet so fall through
  1996.      ELSE
  1997.      <<
  1998.           TEST EQ 'Y' THEN
  1999.           <<
  2000.                IF N NE NUM THEN RETURN (STATE)   // if wrong ack stay in f state
  2001. Z2:
  2002.                0=>NUMTRY                     // reset try counter
  2003.                N+1/64;RB=>N                  // bump packet count
  2004.                IF DEBUG NE THEN
  2005.                <<
  2006.                     ADDVEC(,19,DMESS6)
  2007.                     ADDVEC(,LF,FILNAM)
  2008.                     PUTVEC()
  2009.                >>
  2010.                CLOSE(READSTREAM)             // close currently read file
  2011.                0=>FP                         // reset no file open
  2012.                IF DEBUG NE THEN PUT(LOGSTREAM,26,DMESS7)
  2013.                                              // say getting next file
  2014.                IF GNXTFL() EQ THEN RETURN('B')   // if there isnt one then break
  2015.                IF DEBUG NE THEN              // file got
  2016.                <<
  2017.                     ADDVEC(,12,DMESS8)
  2018.                     ADDVEC(,LF,FILNAM)
  2019.                     PUTVEC()
  2020.                >>
  2021.                RETURN('F')                   // return for more files
  2022.           >>
  2023.           ELSE
  2024.           <<
  2025.                TEST EQ 'E' THEN
  2026.                <<
  2027.                     // deal with error packet
  2028.                     PRERRPKT()
  2029.                     RETURN('A')
  2030.                >>
  2031.                ELSE
  2032.                <<
  2033.                     TEST EQ 0 THEN           // receive fail so stay state
  2034.                     <<
  2035.                          RETURN(STATE)
  2036.                     >>
  2037.                     ELSE
  2038.                     <<
  2039.                          RETURN('A')         // else abort
  2040.                     >>
  2041.                >>
  2042.           >>
  2043.      >>
  2044.      END
  2045.  
  2046. //******************************************************************************
  2047.  
  2048.      ROUTINE SBREAK                          // send break
  2049.  
  2050.      IF NUMTRY GT MAXTRY THEN RETURN('A')    // if too many tries give up
  2051.      +1=>NUMTRY
  2052.      'B'=>TYPE;SPACK()                       // send b packet
  2053.      RPACK()
  2054.      TEST EQ 'N' THEN
  2055.      <<
  2056.           IF (NUM-1=>NUM LT 0) THEN 63=>NUM  // if nak stay in this state
  2057.           IF N NE NUM THEN RETURN(STATE)     // unless nak from next packet
  2058.           GOTO Z3                            // which means ack for this
  2059.      >>
  2060.                                              // packet so fall through
  2061.      ELSE
  2062.      <<
  2063.           TEST EQ 'Y' THEN
  2064.           <<
  2065.                IF N NE NUM THEN RETURN (STATE)   // if wrong ack stay in f state
  2066. Z3:
  2067.                0=>NUMTRY                     // reset try counter
  2068.                N+1/64;RB=>N                  // bump packet count
  2069.                RETURN('C')
  2070.           >>
  2071.           ELSE
  2072.           <<
  2073.                TEST EQ 'E' THEN
  2074.                <<
  2075.                     // deal with error packet
  2076.                     PRERRPKT()
  2077.                     RETURN('A')
  2078.                >>
  2079.                ELSE
  2080.                <<
  2081.                     TEST EQ 0 THEN           // receive fail so stay state
  2082.                     <<
  2083.                          RETURN(STATE)
  2084.                     >>
  2085.                     ELSE
  2086.                     <<
  2087.                          RETURN('A')         // else abort
  2088.                     >>
  2089.                >>
  2090.           >>
  2091.      >>
  2092.      END
  2093.  
  2094. //******************************************************************************
  2095.  
  2096.      ROUTINE FAR_GNXTFL         // returns next filename parameter from filelist
  2097.  
  2098.      TEST IP LT NPARMS  THEN                 // if more to come
  2099.      <<
  2100.           IF IP EQ THEN MOVE(,80,FILELIST,BUF)
  2101.                                              // if first time in then move
  2102.                                              // filelist in
  2103.           MARKS[IP*2+2]-MARKS[IP*2+1]=>LF    // get length of filename
  2104.           MARKS[IP*2+1]=>P                   // set pointer to it
  2105.           MOVE (,LF,FILNAM,FILELIST+P)       // shift it
  2106.           IP+1=>IP                           // inc for next time
  2107.      >>
  2108.      ELSE
  2109.      <<
  2110.           0=> IP;RETURN(//0//)
  2111.      >>
  2112.  
  2113.      RETURN(1)
  2114.      END
  2115.  
  2116. //******************************************************************************
  2117.  
  2118.      ROUTINE FAR_SENDSW             // state table switcher for tx files or text
  2119.  
  2120.      0=>N=>NUMTRY=>REREAD-1=>GP           // init packet number and no tries yet
  2121.      'S'=>STATE                              // start state
  2122.  
  2123.      REPEAT                                  // always loop
  2124.      <<
  2125.           IF DEBUG NE THEN
  2126.           <<
  2127.                STATE=>DMESS10[15]
  2128.                PUT(LOGSTREAM,16,DMESS10)
  2129.           >>
  2130.           TEST STATE EQ 'S' THEN
  2131.           <<
  2132.                SINIT()=>STATE                // send init
  2133.           >>
  2134.           ELSE
  2135.           <<
  2136.                TEST EQ 'F' OR EQ 'X' THEN
  2137.                <<
  2138.                     SFILE()=>STATE           // send filename
  2139.                >>
  2140.                ELSE
  2141.                <<
  2142.                     TEST EQ 'D' THEN
  2143.                     <<
  2144.                          SDATA()=>STATE      // send data
  2145.                     >>
  2146.                     ELSE
  2147.                     <<
  2148.                          TEST EQ 'Z' THEN
  2149.                          <<
  2150.                               SEOF()=>STATE  // send eof
  2151.                          >>
  2152.                          ELSE
  2153.                          <<
  2154.                               TEST EQ 'B' THEN
  2155.                               <<
  2156.                                    SBREAK()=>STATE   // send break
  2157.                               >>
  2158.                               ELSE
  2159.                               <<
  2160.                                    TEST EQ 'C' THEN
  2161.                                    <<
  2162.                                         RETURN(1)   // completed state
  2163.                                    >>
  2164.                                    ELSE
  2165.                                    <<
  2166.                                         CLOSE(READSTREAM)   // must be 'a'
  2167.                                         RETURN(0)   // abort state
  2168.                                    >>
  2169.                               >>
  2170.                          >>
  2171.                     >>
  2172.                >>
  2173.           >>
  2174.      >>
  2175.      ALWAYS
  2176.      END
  2177.  
  2178. //******************************************************************************
  2179.  
  2180.      ROUTINE FAR_DEBRIEF                     // After a transfer report
  2181.                                              // or handle matters arising
  2182.      TEST TIMING EQ 1 THEN                   // if timeout was reason for
  2183.      <<
  2184.                                              // returning here then
  2185.           PUT(INSTREAM,38,MESSTIME)          // write to other kermit user
  2186.           PUT(INSTREAM,2,CRLF)               // still in physical mode.
  2187.           PUT(LOGSTREAM,38,MESSTIME)
  2188.           0=>TIMING
  2189.      >>
  2190.      ELSE
  2191.      <<
  2192.           IF NUMTRY GT MAXTRY OR OLDTRY GT MAXTRY THEN
  2193.           <<
  2194.                // else if retries exceeded
  2195.                PUT(INSTREAM,34,MESSTRY)      // anyway then say so before
  2196.                PUT(INSTREAM,2,CRLF)          // aborting.
  2197.                PUT(LOGSTREAM,34,MESSTRY)
  2198.           >>
  2199.      >>
  2200.      RETURN
  2201.      END
  2202.  
  2203. //******************************************************************************
  2204.  
  2205.      ROUTINE FAR_FILE_PARSER                 // Parses the file list
  2206.  
  2207.      WHILE (,PP LT LEN) DO                   // search rest of line
  2208.      <<
  2209.           (,+1)                              // inc rx(parser pointer)
  2210.           WHILE BUF[] EQ ' ' AND RX LT LEN DO (,+1)   // ignore extra spaces
  2211.           TEST RX NE LEN THEN                // dont do this if eol
  2212.           <<
  2213.                (RX=>MARKS[I]=>RY,+1=>I)      // save pointer to parm in next loc
  2214.                (,RY)                         // retreive rx
  2215.                WHILE BUF[] NE ' ' AND RX LT LEN DO (,+1)   // find end of parm
  2216.  
  2217.                // now rx points to space after parm
  2218.  
  2219.                (RX=>MARKS[I]=>PP,+1=>I)      // save position in next loc
  2220.           >>
  2221.           ELSE                               // eol so arrange while loop
  2222.           <<
  2223.                                              // to end.
  2224.                LEN=>PP
  2225.           >>
  2226.      >>
  2227.  
  2228.      I-1 SEXT /2=>NPARMS                     // remember number of parms
  2229.  
  2230.      RETURN
  2231.      END
  2232.  
  2233. //******************************************************************************
  2234.  
  2235.      ROUTINE FAR_SERVER_CONTROL              // this is the server cycle
  2236.  
  2237.      PUT(OUTSTREAM,58,SIGNON)                //tell oper to go away
  2238.      CLOSE(INSTREAM)
  2239.      OPEN(INSTREAM,HEX'88')                  //Physical update mode
  2240.      CONTROL(INSTREAM,1,STOP_ON_CR)          //terminates get on C.R.
  2241.      CONTROL(INSTREAM,1,EVEN)                //Turn on checking
  2242.      0=>N=>NUMTRY                            // server packets always zero
  2243.      TIMEOUT=>SAVE_TIMEOUT                   // change timeout on server
  2244.      SERVER_TIMEOUT=>TIMEOUT                 //     idle to 30 sec
  2245.      CONTROL(INSTREAM,TIMEOUT,PGTCODE)       //declare new timout for put-gets
  2246.      REPEAT                                  // start server loop
  2247.      <<
  2248.           TEST RPACK() EQ 'S' THEN           // if S then receive sent files
  2249.           <<
  2250.                SAVE_TIMEOUT=>TIMEOUT         // restore timeout
  2251.                CONTROL(INSTREAM,TIMEOUT,PGTCODE)
  2252.                                              //declare new timout for put-gets
  2253.                TEST RECSW() EQ THEN PUT(LOGSTREAM,14,DMESS13)
  2254.                                              // Do receive command
  2255.                ELSE PUT(LOGSTREAM,5,DMESS14)
  2256.                CALL DEBRIEF                  // tidy up after
  2257.                0=>N=>NUMTRY
  2258.                TIMEOUT=>SAVE_TIMEOUT         // re-extend timeout
  2259.                SERVER_TIMEOUT=>TIMEOUT
  2260.                CONTROL(INSTREAM,TIMEOUT,PGTCODE)
  2261.                                              //declare new timout for put-gets
  2262.           >>
  2263.           ELSE
  2264.           <<
  2265.                TEST EQ 'R' THEN
  2266.                                              // if R or X then send the required
  2267.                                              // files
  2268.                <<
  2269.                     FAR_SEND_F_OR_X('F')     // set up for file sending
  2270.                >>
  2271.                ELSE TEST EQ 'G' AND (,LEN NE 0) THEN
  2272.                                              // if generic command with data
  2273.                <<
  2274.                     TEST DATABUF[0] EQ 'F' OR EQ 'L' THEN
  2275.                                              // then if Finish Quit
  2276.                     <<
  2277.                          TEST EQ 'F' THEN
  2278.                          <<
  2279.                               'Y'=>TYPE;0=>LEN=>LISTEN;SPACK()   // ack it first
  2280.                          >>
  2281.                          ELSE
  2282.                          <<
  2283.                               MOVE(,47,DATABUF,BYEMESS)
  2284.                                              // say cannot logout (L)
  2285.                               ERROR(,47)
  2286.                               PUT(LOGSTREAM,0,0)
  2287.                               CLOSEDOWN(1)
  2288.                               STOP(0)
  2289.                          >>
  2290.                          SAVE_TIMEOUT=>TIMEOUT   // restore timeout
  2291.                          CLOSE(INSTREAM)
  2292.                          OPEN(INSTREAM,TEXTIN)   // back to logical
  2293.                          CONTROL(INSTREAM,,DEFAULT)   // reset all
  2294.                          CONTROL(INSTREAM,'C' ALSH 8 +8,ALTCHAR)
  2295.                                              // restore backspace
  2296.                          RETURN
  2297.                     >>
  2298.                     ELSE TEST EQ 'T' THEN    // type a file
  2299.                     <<
  2300.                          //DATABUF[1]-' '=>LEN//
  2301.                          LEN-2=>LEN
  2302.                          MOVE(,RA NEG,DATABUF+RA-1,RY+2)
  2303.                          FAR_SEND_F_OR_X('X')   // set up for text sending
  2304.                     >>
  2305.                     ELSE
  2306.                     <<
  2307.                          // otherwise invalid command
  2308.                          MOVE(,28,DATABUF,NOTSERV)
  2309.                          ERROR(,28)
  2310.                          0=>N
  2311.                     >>
  2312.                >>
  2313.                ELSE
  2314.                <<
  2315.                     TEST EQ 'I' THEN         // if I then do receive init
  2316.                     <<
  2317.                          RPAR()              // get parms
  2318.                          TEST BINFILE NE AND EIGHTQ EQ 'N' THEN
  2319.                          <<
  2320.                               // if binary file and quoting not agreed
  2321.                               MOVE(,53,DATABUF,MESSYBIT)
  2322.                               ERROR(,53)
  2323.                          >>
  2324.                          ELSE
  2325.                          <<
  2326.                               SPAR()
  2327.                               'Y'=>TYPE;9=>LEN;SPACK()
  2328.                                              // ack with my parms
  2329.                          >>
  2330.                          0=>N
  2331.                     >>
  2332.                     //ELSE TEST EQ 'C' THEN//    //host command//
  2333.                     //<<//
  2334.                     // here go the bits to implement host commands
  2335.                     // these will be DL specific as GEC COMM cannot 'fork'
  2336.                     // another command.
  2337.                     // something like fork 'output %m'
  2338. //                fork 'command (proforma must specify AIDA shell)'
  2339. //                send %m with 'X' header to type file on terminal
  2340.                     //>>//
  2341.                     ELSE TEST EQ 0 THEN      // if invalid packet send Nak
  2342.                     <<
  2343.                          'N'=>TYPE;N=>NUM;0=>LEN
  2344.                          SPACK()
  2345.                          0=>N
  2346.                     >>
  2347.                     ELSE
  2348.                     <<
  2349.                          MOVE(,28,DATABUF,NOTSERV)
  2350.                                              // if anything else assume non-
  2351.                          ERROR(,28)          // implemented server command
  2352.                          0=>N
  2353.                     >>
  2354.                >>
  2355.           >>
  2356.      >>
  2357.      ALWAYS
  2358.      END
  2359.  
  2360. //******************************************************************************
  2361.  
  2362.      ROUTINE FAR_SEND_F_OR_X(F_OR_X_FLAG)   // sends File or teXt (setting flag)
  2363.  
  2364.      CALL FILE_DE_PREFIX                     // deprefix the f pak
  2365.      MOVE(0-1=>PP,LEN,BUF,0=>IB+BUFFER)      // copy to buf etc
  2366.      TRANSLATE(,LEN,BUF,TABLE)               // convert to upper case
  2367.      1=>I
  2368.      CALL FILE_PARSER                        // get file names
  2369.      IF NE THEN                              // if files present
  2370.      <<
  2371.           0=>IP
  2372.           CALL GNXTFL                        // get first file name
  2373.      >>
  2374.      0=>FP
  2375.      SAVE_TIMEOUT=>TIMEOUT                   // restore timer
  2376.      CONTROL(INSTREAM,TIMEOUT,PGTCODE)
  2377.                                              //declare new timout for put-gets
  2378.      TEST SENDSW() EQ THEN PUT(LOGSTREAM,11,DMESS15)
  2379.                                              // do send command
  2380.      ELSE PUT(LOGSTREAM,5,DMESS14)
  2381.      CALL DEBRIEF
  2382.      0=>N=>NUMTRY                            // tidy up after
  2383.      TIMEOUT=>SAVE_TIMEOUT                   // re-extend timeout
  2384.      SERVER_TIMEOUT=>TIMEOUT
  2385.      CONTROL(INSTREAM,TIMEOUT,PGTCODE)
  2386.                                              //declare new timout for put-gets
  2387.      RETURN
  2388.      END
  2389.  
  2390. //******************************************************************************
  2391.  
  2392.      ROUTINE FAR_HELPER(,,HELP)              // writes out a vector paragraph
  2393.                                              // does a cr on ~ and ends on $
  2394.      (,0=>OFS)                             // ry contains address of help vector
  2395.      REPEAT
  2396.      <<
  2397.           WHILE HELP[] NE '$' AND NE '~' DO (,RX+1)
  2398.                                              // look for either special char
  2399.           PUT(OUTSTREAM,RX-OFS,HELP+OFS)     // in either case write line
  2400.           (HELP[+OFS],+1=>OFS)               // offset address to next line
  2401.      >>
  2402.      UNTIL EQ '$'                            // continue until end found
  2403.      RETURN
  2404.      END
  2405.  
  2406. //******************************************************************************
  2407.  
  2408.      ROUTINE FAR_SHOWER                      // show command
  2409.  
  2410.      PUT(OUTSTREAM,76,TITLE+1)
  2411.      PUT(OUTSTREAM,76,SHOWVEC)
  2412.      CONTROL(OUTSTREAM,,NOCRLF)
  2413.      PUT(OUTSTREAM,25,SHOWVEC+76)
  2414.      YNPRINT(DEBUG)
  2415.      CONTROL(OUTSTREAM,,NOCRLF)
  2416.      PUT(OUTSTREAM,25,SHOWVEC+151)
  2417.      SPRINT(EOL)
  2418.      CONTROL(OUTSTREAM,,NOCRLF)
  2419.      PUT(OUTSTREAM,25,SHOWVEC+176)
  2420.      SPRINT(STX)
  2421.      CONTROL(OUTSTREAM,,NOCRLF)
  2422.      PUT(OUTSTREAM,25,SHOWVEC+201)
  2423.      SPRINT(PAD)
  2424.      CONTROL(OUTSTREAM,,NOCRLF)
  2425.      PUT(OUTSTREAM,25,SHOWVEC+226)
  2426.      SPRINT(PADCAR)
  2427.      CONTROL(OUTSTREAM,,NOCRLF)
  2428.      PUT(OUTSTREAM,25,SHOWVEC+251)
  2429.      SPRINT(DELAY/MILLI)
  2430.      CONTROL(OUTSTREAM,,NOCRLF)
  2431.      PUT(OUTSTREAM,25,SHOWVEC+100+176)
  2432.      SPRINT(MAXTRY)
  2433.      CONTROL(OUTSTREAM,,NOCRLF)
  2434.      PUT(OUTSTREAM,25,SHOWVEC+100+201)
  2435.      SPRINT(MYTIME)
  2436.      CONTROL(OUTSTREAM,,NOCRLF)
  2437.      PUT(OUTSTREAM,25,SHOWVEC+100+226)
  2438.      SPRINT(TIMEOUT)
  2439.      CONTROL(OUTSTREAM,,NOCRLF)
  2440.      PUT(OUTSTREAM,25,SHOWVEC+100+251)
  2441.      SPRINT(MYQUOTE)
  2442.      CONTROL(OUTSTREAM,,NOCRLF)
  2443.      PUT(OUTSTREAM,25,SHOWVEC+100+100+176)
  2444.      SPRINT(MY8BIT)
  2445.      CONTROL(OUTSTREAM,,NOCRLF)
  2446.      PUT(OUTSTREAM,25,SHOWVEC+100+100+201)
  2447.      YNPRINT(BINFILE)
  2448.      CONTROL(OUTSTREAM,,NOCRLF)
  2449.      PUT(OUTSTREAM,25,SHOWVEC+100+100+226)
  2450.      SPRINT(MYRPEAT)
  2451.      CONTROL(OUTSTREAM,,NOCRLF)
  2452.      PUT(OUTSTREAM,25,SHOWVEC+100+125+226)
  2453.      YNPRINT(NORMAL)
  2454.      RETURN
  2455.      END
  2456.  
  2457. //******************************************************************************
  2458.  
  2459.      ROUTINE YNPRINT(SAVE)
  2460.  
  2461.      CONTROL(OUTSTREAM,,NOCRLF)
  2462.      PUT(OUTSTREAM,4,HELP3+2)
  2463.      TEST SAVE EQ THEN PUT(OUTSTREAM,3,OFF)
  2464.      ELSE PUT(OUTSTREAM,2,OFF+3)
  2465.      RETURN(SAVE)
  2466.      END
  2467.  
  2468. //******************************************************************************
  2469.  
  2470.      ROUTINE SPRINT(SAVE)                    // prints ra as a 6 char int
  2471.  
  2472.      TOCHAR(,6,DBUF)
  2473.      PUT(OUTSTREAM,6,DBUF)
  2474.      RETURN(SAVE)
  2475.      END
  2476.  
  2477. //******************************************************************************
  2478.  
  2479.      ROUTINE TOGGLE(SAVE)       // this sets parameter on or off(1 or 0) by word
  2480.  
  2481.      TEST COMPARE(,LEN,BUF+PP,OFF) EQ   THEN 0   //word is "off"
  2482.      ELSE TEST COMPARE(,LEN,BUF+PP,OFF+3) EQ THEN 1   //word is "on"
  2483.      ELSE
  2484.      <<
  2485.           PUT(OUTSTREAM,17,INVPARM)
  2486.           RETURN(SAVE)
  2487.      >>
  2488.      RETURN
  2489.      END
  2490.  
  2491. //******************************************************************************
  2492.  
  2493.      ROUTINE FAR_PARSER                      // command parser
  2494.  
  2495.      PUT(OUTSTREAM,0,0)                      // make sure on new line
  2496.  
  2497.      REPEAT                                  // loop until commanded
  2498.      <<
  2499.  
  2500.           IF TAKE_FILE EQ THEN               // if no take file
  2501.           <<
  2502.                CONTROL(OUTSTREAM,,NOCRLF)
  2503.                PUT(OUTSTREAM,11,PROMPT)      // output prompt
  2504.           >>
  2505.           TEST TAKE_FILE EQ THEN             // if no take file
  2506.           <<
  2507.                GET(INSTREAM,80,BUF)
  2508.           >>
  2509.           ELSE
  2510.           <<
  2511.                GET(WITHSTREAM,80,BUF)        // otherwise read file
  2512.                IF & EOFMASK EQ EOF THEN
  2513.                <<
  2514.                     RETURN                   // if eof return
  2515.                >>
  2516.           >>
  2517.           PUT(LOGSTREAM,,)                   // echo to log file
  2518.           (,=>LEN-RX,LCMASK)                 // save length and set rx =0
  2519.  
  2520.           REPEAT                             // convert to upper case loop
  2521.           <<
  2522.                                              // converts all alphas in line
  2523.                IF BUF[] GT HEX'60' AND LT HEX'7B' THEN & RY  =>BUF[]
  2524.                (,+1)
  2525.           >>
  2526.           UNTIL (,RX GE LEN)
  2527.  
  2528.           (,0)
  2529.           WHILE (BUF[] EQ ' ' AND RX LT LEN) DO (,+1)   // ignore leading spaces
  2530.           (,RX=>J)                           // save start of command
  2531.           WHILE (BUF[] NE ' ' AND RX LT LEN) DO  (,+1)
  2532.                                              // search line for space
  2533. // now rx points to space at end of command(or past last space if no command)
  2534.           (,=>PP)                            // save position
  2535.  
  2536.           IF (,RX EQ OR PP EQ J) THEN GOTO  FAR_MISS
  2537.                                              // if not null command then
  2538.           <<
  2539.                (0=>I)                        // init counter
  2540.  
  2541.                WHILE I LE COMSIZ AND COMPARE(,PP-J,BUF+J,
  2542.                COMMANDS+I) NE  DO (I+1=>I)
  2543.  
  2544. // either command list exhausted and no such command or command found
  2545.  
  2546.                TEST (I GT COMSIZ ) THEN
  2547.                <<
  2548.                     // if no such command found
  2549.                     PUT(OUTSTREAM,15,COMMESS)   // then error
  2550.                >>
  2551.                ELSE
  2552.                <<
  2553.                     // command valid
  2554.                     I=>MARKS[0]              // save command value
  2555.                     (,+1=>I)                 // init for first parm
  2556.  
  2557.                     CALL FILE_PARSER         // extract file names
  2558.  
  2559.                     MARKS[0]                 // otherwise goto command
  2560.                     GOTO WHATCOM[RA]
  2561.  
  2562. SE:
  2563.                     TEST NPARMS NE THEN      // if send command (0)
  2564.                     <<
  2565.                          // and there was a parameter given
  2566.                          0=>IP               // init gnxtfl first time
  2567.  
  2568.                          CALL GNXTFL         // get first file name
  2569.                          1=>SFLG             // set kermit style sendflag
  2570.                          RETURN              // return for sending
  2571.                     >>
  2572.                     // otherwise filelist will default
  2573.  
  2574.                     ELSE
  2575.                     <<
  2576.                          1=>SFLG
  2577.                          RETURN              //defaulted to %c
  2578.                     >>
  2579.  
  2580. EX:
  2581.                                              //quit or exit
  2582.                     PUT(LOGSTREAM,0,0)
  2583.                     CLOSEDOWN(0)
  2584.                     STOP(0)
  2585.  
  2586. RE:
  2587.                                              // receive command
  2588.                     TEST NPARMS GT 1 THEN PUT(OUTSTREAM,17,TOOMESS)
  2589.                     ELSE
  2590.                     <<
  2591.                          IF NPARMS EQ 1 THEN // if a parameter then use it
  2592.                          <<
  2593.                               0=>IP
  2594.                               CALL GNXTFL
  2595.                          >>
  2596.                          1=>RFLG             // set kermit flag for rx
  2597.                          RETURN              // return for receiving
  2598.                     >>
  2599.  
  2600. ST:
  2601.                                              // set command
  2602.                     TEST NPARMS GT 9 THEN PUT(OUTSTREAM,17,TOOMESS)
  2603.                                              // max 9 parms
  2604.                     ELSE
  2605.                     <<
  2606.                          0=>I
  2607.  
  2608. NODDYWHILE:
  2609.                          WHILE I LT NPARMS  DO
  2610.                                              // silly way to get over disp error
  2611.                          <<
  2612.                               GOTO LOOP      // do loop
  2613.                          >>
  2614.                          GOTO ENDLOOP        // miss loop
  2615. LOOP:
  2616.  
  2617.                          MARKS[I*2+2]-MARKS[I*2+1]=>LEN   // locate next parm
  2618.                          MARKS[I*2+1]=>PP
  2619.                          0=>J
  2620.  
  2621.                          // find what parameter it was
  2622.  
  2623.                          WHILE J LE PARMSIZ AND COMPARE(,LEN,BUF+PP,
  2624.                          PARAMS+J)NE DO (J+1=>J)
  2625.  
  2626.                          // check not too many
  2627.  
  2628.                          TEST J GT PARMSIZ THEN PUT(OUTSTREAM,17,INVPARM)
  2629.                          ELSE
  2630.                          <<
  2631.                               I+1=>I         // now find its value parameter
  2632.                               TEST I GE NPARMS THEN
  2633.                               <<
  2634.                                    PUT(OUTSTREAM,17,INVPARM)
  2635.                                    PUT(OUTSTREAM,LEN,BUF+PP)
  2636.                               >>
  2637.                               ELSE
  2638.                               <<
  2639.                                    MARKS[I*2+2]-MARKS[I*2+1]=>LEN
  2640.                                    MARKS[I*2+1]=>PP
  2641.  
  2642.                                    FROMCHAR(,LEN,BUF+PP)   // unchar it
  2643.  
  2644.                                    // now search to find what command
  2645.  
  2646.                                    TEST (,J EQ 3) THEN TOGGLE(DEBUG)=>DEBUG
  2647.  
  2648.                                    ELSE
  2649.                                    <<
  2650.                                         TEST (,
  2651.                                         J EQ 12) THEN TOGGLE(REMOTE)=>REMOTE
  2652.                                         ELSE
  2653.                                         <<
  2654.                                         TEST (,
  2655.                                         J EQ 18) THEN TOGGLE(IMAGE)=>IMAGE
  2656.                                         ELSE
  2657.                                         <<
  2658.                                         TEST (,J EQ 0) THEN =>EOL
  2659.                                         ELSE
  2660.                                         <<
  2661.                                         TEST (,J EQ 23) THEN =>STX
  2662.                                         ELSE
  2663.                                         <<
  2664.                                         TEST (,J EQ 26) THEN =>PAD
  2665.                                         ELSE
  2666.                                         <<
  2667.                                         TEST (,J EQ 29) THEN =>PADCAR
  2668.                                         ELSE
  2669.                                         <<
  2670.                                         TEST(,J EQ 33) THEN
  2671.                                         <<
  2672.                                              // check valid delay
  2673.                                         *MILLI=>DELAY
  2674.                                         IF LT THEN
  2675.                                         <<
  2676.                                         PUT(OUTSTREAM,22,RANGEMESS)
  2677.                                              // if not say so
  2678.                                         0=>DELAY   // and set smallest
  2679.                                         >>
  2680.                                         >>
  2681.                                         ELSE
  2682.                                         <<
  2683.                                         TEST(,J EQ 37) THEN
  2684.                                         <<
  2685.                                         // check valid number
  2686.                                         =>MAXTRY
  2687.                                         IF GT 50 OR LT 0 THEN   // if not say so
  2688.                                         <<
  2689.                                         PUT(OUTSTREAM,22,RANGEMESS)
  2690.                                         0=>MAXTRY
  2691.                                         >>
  2692.                                         >>
  2693.                                         ELSE
  2694.                                         <<
  2695.                                         TEST(,J EQ 8) THEN
  2696.                                         <<
  2697.                                         // same for these too
  2698.                                         =>MYTIME
  2699.                                         IF LT 1 THEN
  2700.                                         <<
  2701.                                         PUT(OUTSTREAM,22,RANGEMESS)
  2702.                                         1=>MYTIME
  2703.                                         >>
  2704.                                         >>
  2705.                                         ELSE
  2706.                                         <<
  2707.                                         TEST(,J EQ 48) THEN
  2708.                                         <<
  2709.                                         =>TIMEOUT   // now in secs
  2710.                                         IF LT 1 THEN
  2711.                                         <<
  2712.                                         PUT(OUTSTREAM,22,RANGEMESS)
  2713.                                         1=>TIMEOUT
  2714.                                         >>
  2715.                                         >>
  2716.                                         ELSE
  2717.                                         <<
  2718.                                         TEST(,J EQ 43) THEN=>MYQUOTE
  2719.                                         ELSE
  2720.                                         <<
  2721.                                         TEST(,J EQ 55) THEN=>MY8BIT
  2722.                                         ELSE
  2723.                                         <<
  2724.                                         TEST(,
  2725.                                         J EQ 59) THEN TOGGLE(BINFILE)=>BINFILE
  2726.                                         ELSE
  2727.                                         <<
  2728.                                         TEST(,J EQ 65) THEN=>MYRPEAT
  2729.                                         ELSE
  2730.                                         <<
  2731.                                         TEST(,
  2732.                                         J EQ 71) THEN TOGGLE(NORMAL)=>NORMAL
  2733.                                         ELSE
  2734.                                         <<
  2735.                                         TEST(,J EQ 77) THEN=>RPSIZ
  2736.                                         ELSE
  2737.                                         <<
  2738.                                         PUT(OUTSTREAM,17,INVPARM)
  2739.                                         >>
  2740.                                         >>
  2741.                                         >>
  2742.                                         >>
  2743.                                         >>
  2744.                                         >>
  2745.                                         >>
  2746.                                         >>
  2747.                                         >>
  2748.                                         >>
  2749.                                         >>
  2750.                                         >>
  2751.                                         >>
  2752.                                         >>
  2753.                                         >>
  2754.                                         >>
  2755.                                    >>
  2756.                               >>
  2757.                          >>
  2758.                          I+1=>I
  2759.                          GOTO NODDYWHILE     // repeat the while
  2760. ENDLOOP:
  2761.                          // come here when while fails
  2762.                     >>
  2763.                     GOTO MISS
  2764. SH:
  2765.                                              // show command
  2766.                     TEST NPARMS GT  THEN PUT(OUTSTREAM,17,TOOMESS)
  2767.                     ELSE
  2768.                     <<
  2769.                          CALL SHOWER
  2770.                     >>
  2771.                     GOTO MISS
  2772.  
  2773. SV:
  2774.                                              // server mode
  2775.                     1=>SERVER
  2776.                     CALL SERVER_CONTROL
  2777.                     0=>SERVER
  2778.                     GOTO MISS
  2779. HP:
  2780.                                              // help command
  2781.                     TEST NPARMS GT 7 THEN PUT(OUTSTREAM,17,TOOMESS)
  2782.                     ELSE
  2783.                     <<
  2784.                          0=>I
  2785.                          WHILE I LT NPARMS  DO
  2786.                          <<
  2787.                               MARKS[I*2+2]-MARKS[I*2+1]=>LEN
  2788.                               MARKS[I*2+1]=>PP
  2789.                               0=>J
  2790.                               WHILE J LE COMSIZ AND COMPARE(,LEN,BUF+PP,
  2791.                               COMMANDS+J)NE DO (J+1=>J)
  2792.                               TEST J GT COMSIZ THEN PUT(OUTSTREAM,14,NOHELP)
  2793.                               ELSE
  2794.                               <<
  2795.                                    GOTO HELPARMS[J]
  2796. HSE:
  2797.                                    HELPER(,,HELP1) ;GOTO AIDED
  2798. HRE:
  2799.                                    HELPER(,,HELP2) ;GOTO AIDED
  2800. HST:
  2801.                                    HELPER(,,HELP3) ;GOTO AIDED
  2802. HSH:
  2803.                                    HELPER(,,HELP4) ;GOTO AIDED
  2804. HHP:
  2805.                                    HELPER(,,HELP5) ;GOTO AIDED
  2806. HQU:
  2807.                                    HELPER(,,HELP6) ;GOTO AIDED
  2808. HSV:
  2809.                                    HELPER(,,HELP7) ;GOTO AIDED
  2810.  
  2811. EH:
  2812.                                    PUT(OUTSTREAM,14,NOHELP)
  2813. AIDED:
  2814.                               >>
  2815.                               // help done
  2816.                               I+1=>I
  2817.                          >>
  2818.                          IF NPARMS EQ THEN HELPER(,,TITLE)
  2819.                     >>
  2820.                     GOTO MISS
  2821.  
  2822. E:
  2823.                     PUT(OUTSTREAM,15,COMMESS)   // error, no such command
  2824.                >>
  2825.           >>
  2826. MISS:
  2827.      >>
  2828.      ALWAYS
  2829.      END
  2830.  
  2831. //******************************************************************************
  2832.  
  2833.      ROUTINE DO_THE_WORK
  2834.  
  2835.      IF (CFLG+RFLG+SFLG-1 NE ) THEN
  2836.      <<
  2837.           CLOSEDOWN(0)
  2838.           STOP(0)
  2839.      >>
  2840.      CLOSE(INSTREAM)
  2841.      OPEN(INSTREAM,HEX'88')                  // physical update mode
  2842.      CONTROL(INSTREAM,1,STOP_ON_CR)          // terminate gets on cr
  2843.      CONTROL(INSTREAM,1,EVEN)                // check and strip even parity
  2844.      CONTROL(INSTREAM,TIMEOUT,PGTCODE)       //timeout for put-gets
  2845.      IF DEBUG NE THEN
  2846.      <<
  2847.           IF SFLG NE THEN PUT(LOGSTREAM,12,DMESS11)
  2848.           IF RFLG NE THEN PUT(LOGSTREAM,15,DMESS12)
  2849.      >>
  2850.      TEST RFLG NE THEN                       // receive command
  2851.      <<
  2852.           TEST RECSW() EQ THEN PUT(LOGSTREAM,14,DMESS13)
  2853.                                              // DO RECEIVE COMMAND
  2854.           ELSE PUT(LOGSTREAM,5,DMESS14)
  2855.      >>
  2856.      ELSE
  2857.      <<
  2858.           IF SFLG NE THEN                    // send command
  2859.           <<
  2860.                0=>FP                         // set file open switch to 'closed'
  2861.                'F' => F_OR_X_FLAG            // set File or teXt to File
  2862.                TEST SENDSW() EQ THEN PUT(LOGSTREAM,11,DMESS15)
  2863.                                              // do send command
  2864.                ELSE PUT(LOGSTREAM,5,DMESS14)
  2865.           >>
  2866.      >>
  2867.  
  2868.      DEBRIEF()
  2869.  
  2870.      CLOSE(INSTREAM)
  2871.      OPEN(INSTREAM,TEXTIN)                   // back to logical
  2872.      CONTROL(INSTREAM,,DEFAULT)              // reset all
  2873.      CONTROL(INSTREAM,'C' ALSH 8 +8,ALTCHAR) // restore backspace
  2874.  
  2875.      RETURN
  2876.      END
  2877.  
  2878. //******************************************************************************
  2879.  
  2880. ENTRYPOINT:
  2881.      OPEN(INSTREAM,//HEXPRINT +//TEXTIN)
  2882.      /!GEC/!CONTROL(INSTREAM,5,CONLT)        // no case conversion
  2883.      OPEN(OUTSTREAM,TEXTOUT)
  2884.      DMCONNECT(LOGSTREAM,23,LOGVEC)
  2885.      OPEN(LOGSTREAM,TEXTOUT)
  2886.      GETSTREAMARG(WITHSTREAM,80,BUF)         // look to see if WITH given
  2887.      COMPARE(,4,BUF,SINK)                    // compare WITH arg with SINK
  2888.      IF NE THEN                              // if Not SINK then read file
  2889.      <<
  2890.                                              // Note-def proforma gives SINK
  2891.           0=>SFLG=>RFLG
  2892.           OPEN(WITHSTREAM,TEXTIN)
  2893.           1=>TAKE_FILE
  2894.           PUT(LOGSTREAM,32,TAKING)           // inform user of taking from
  2895.           PUT(OUTSTREAM,32,TAKING)           // file
  2896.           CALL PARSER                        // Parse commands therein
  2897.           CALL DO_THE_WORK                   // see if rx or tx to do
  2898.           PUT(LOGSTREAM,19,TAKEN)            // inform user take is finished
  2899.           PUT(OUTSTREAM,19,TAKEN)
  2900.           0=>TAKE_FILE
  2901.           CLOSE(WITHSTREAM)
  2902.      >>
  2903.                                              // now continue as normal
  2904.      REPEAT
  2905.      <<
  2906.           0=>SFLG=>RFLG
  2907.           PUT(OUTSTREAM,76,TITLE+1)
  2908.           PUT(OUTSTREAM,76,TITLE+78)
  2909.           CALL PARSER                        // find and execute commands etc
  2910.           CALL DO_THE_WORK                   // see if rx or tx to do
  2911.      >>
  2912.      ALWAYS
  2913.  
  2914.      END
  2915.  
  2916. //******************************************************************************
  2917.